lib/DBIx/Class/CDBICompat/AccessorMapping.pm

   1 package DBIx::Class::CDBICompat::AccessorMapping;
   2
   3 use strict;
   4 use warnings;
   5
   6 sub mk_group_accessors {
   7   my ($class, $group, @cols) = @_;
   8   unless ($class->can('accessor_name') || $class->can('mutator_name')) {
   9     return $class->next::method($group => @cols);
  10   }
  11   foreach my $col (@cols) {
  12     my $ro_meth = ($class->can('accessor_name')
  13                     ? $class->accessor_name($col)
  14                     : $col);
  15     my $wo_meth = ($class->can('mutator_name')
  16                     ? $class->mutator_name($col)
  17                     : $col);
  18     #warn "$col $ro_meth $wo_meth";
  19     if ($ro_meth eq $wo_meth) {
  20       $class->next::method($group => [ $ro_meth => $col ]);
  21     } else {
  22       $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
  23       $class->mk_group_wo_accessors($group => [ $wo_meth => $col ]);
  24     }
  25   }
  26 }
  27
  28 sub new {
  29   my ($class, $attrs, @rest) = @_;
  30   $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
  31   foreach my $col ($class->columns) {
  32     if ($class->can('accessor_name')) {
  33       my $acc = $class->accessor_name($col);
  34       $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
  35     }
  36     if ($class->can('mutator_name')) {
  37       my $mut = $class->mutator_name($col);
  38       $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
  39     }
  40   }
  41   return $class->next::method($attrs, @rest);
  42 }
  43
  44 1;