1package # hide from PAUSE Indexer 2 DBIx::Class::CDBICompat::AccessorMapping; 3 4use strict; 5use warnings; 6 7sub mk_group_accessors { 8 my ($class, $group, @cols) = @_; 9 10 foreach my $col (@cols) { 11 my($accessor, $col) = ref $col ? @$col : (undef, $col); 12 13 my($ro_meth, $wo_meth); 14 if( defined $accessor and ($accessor ne $col)) { 15 $ro_meth = $wo_meth = $accessor; 16 } 17 else { 18 $ro_meth = $class->accessor_name_for($col); 19 $wo_meth = $class->mutator_name_for($col); 20 } 21 22 # warn "class: $class / col: $col / ro: $ro_meth / wo: $wo_meth\n"; 23 if ($ro_meth eq $wo_meth or # they're the same 24 $wo_meth eq $col) # or only the accessor is custom 25 { 26 $class->next::method($group => [ $ro_meth => $col ]); 27 } 28 else { 29 $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]); 30 $class->mk_group_wo_accessors($group => [ $wo_meth => $col ]); 31 } 32 } 33} 34 35 36sub accessor_name_for { 37 my ($class, $column) = @_; 38 if ($class->can('accessor_name')) { 39 return $class->accessor_name($column) 40 } 41 42 return $column; 43} 44 45sub mutator_name_for { 46 my ($class, $column) = @_; 47 if ($class->can('mutator_name')) { 48 return $class->mutator_name($column) 49 } 50 51 return $column; 52} 53 54 55sub new { 56 my ($class, $attrs, @rest) = @_; 57 $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH'; 58 foreach my $col ($class->columns) { 59 my $acc = $class->accessor_name_for($col); 60 $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc}; 61 62 my $mut = $class->mutator_name_for($col); 63 $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut}; 64 } 65 return $class->next::method($attrs, @rest); 66} 67 681; 69