lib/DBIx/Class/CDBICompat/AccessorMapping.pm

   1 package # hide from PAUSE Indexer
   2     DBIx::Class::CDBICompat::AccessorMapping;
   3
   4 use strict;
   5 use warnings;
   6
   7 sub mk_group_accessors {
   8   my ($class, $group, @cols) = @_;
   9   unless ($class->_can_accessor_name_for || $class->_can_mutator_name_for) {
  10     return $class->next::method($group => @cols);
  11   }
  12   foreach my $col (@cols) {
  13     my $ro_meth = $class->_try_accessor_name_for($col);
  14     my $wo_meth = $class->_try_mutator_name_for($col);
  15
  16     # warn "class: $class / col: $col / ro: $ro_meth / wo: $wo_meth\n";
  17     if ($ro_meth eq $wo_meth or     # they're the same
  18         $wo_meth eq $col)           # or only the accessor is custom
  19     {
  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 # CDBI 3.0.7 decided to change "accessor_name" and "mutator_name" to
  29 # "accessor_name_for" and "mutator_name_for".  This is recent enough
  30 # that we should support both.  CDBI does.
  31 sub _can_accessor_name_for {
  32     my $class = shift;
  33     return $class->can("accessor_name") || $class->can("accessor_name_for");
  34 }
  35
  36 sub _can_mutator_name_for {
  37     my $class = shift;
  38     return $class->can("mutator_name") || $class->can("mutator_name_for");
  39 }
  40
  41 sub _try_accessor_name_for {
  42     my($class, $column) = @_;
  43
  44     my $method = $class->_can_accessor_name_for;
  45     return $column unless $method;
  46     return $class->$method($column);
  47 }
  48
  49 sub _try_mutator_name_for {
  50     my($class, $column) = @_;
  51
  52     my $method = $class->_can_mutator_name_for;
  53     return $column unless $method;
  54     return $class->$method($column);
  55 }
  56
  57
  58 sub new {
  59   my ($class, $attrs, @rest) = @_;
  60   $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
  61   foreach my $col ($class->columns) {
  62     if ($class->_can_accessor_name_for) {
  63       my $acc = $class->_try_accessor_name_for($col);
  64       $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
  65     }
  66     if ($class->_can_mutator_name_for) {
  67       my $mut = $class->_try_mutator_name_for($col);
  68       $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
  69     }
  70   }
  71   return $class->next::method($attrs, @rest);
  72 }
  73
  74 1;