Reorder the accessor_name_for() check to get the more likely one first to
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / AccessorMapping.pm
CommitLineData
c0e7b4e5 1package # hide from PAUSE Indexer
2 DBIx::Class::CDBICompat::AccessorMapping;
ea2e61bf 3
4use strict;
5use warnings;
6
b8e1e21f 7sub mk_group_accessors {
8 my ($class, $group, @cols) = @_;
e60dc79f 9 unless ($class->_can_accessor_name_for || $class->_can_mutator_name_for) {
147dd158 10 return $class->next::method($group => @cols);
ea2e61bf 11 }
12 foreach my $col (@cols) {
e60dc79f 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 {
147dd158 20 $class->next::method($group => [ $ro_meth => $col ]);
ea2e61bf 21 } else {
b8e1e21f 22 $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
23 $class->mk_group_wo_accessors($group => [ $wo_meth => $col ]);
ea2e61bf 24 }
25 }
26}
27
e60dc79f 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.
31sub _can_accessor_name_for {
32 my $class = shift;
2d8ced39 33 return $class->can("accessor_name_for") || $class->can("accessor_name");
e60dc79f 34}
35
36sub _can_mutator_name_for {
37 my $class = shift;
2d8ced39 38 return $class->can("mutator_name_for") || $class->can("mutator_name");
e60dc79f 39}
40
41sub _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
49sub _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
75a23b3e 58sub new {
9bc6db13 59 my ($class, $attrs, @rest) = @_;
701da8c4 60 $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
103647d5 61 foreach my $col ($class->columns) {
e60dc79f 62 if ($class->_can_accessor_name_for) {
63 my $acc = $class->_try_accessor_name_for($col);
75a23b3e 64 $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
9bc6db13 65 }
e60dc79f 66 if ($class->_can_mutator_name_for) {
67 my $mut = $class->_try_mutator_name_for($col);
75a23b3e 68 $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
9bc6db13 69 }
70 }
75a23b3e 71 return $class->next::method($attrs, @rest);
9bc6db13 72}
73
ea2e61bf 741;