Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE Indexer |
2 | DBIx::Class::CDBICompat::AccessorMapping; |
ea2e61bf |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
b8e1e21f |
7 | sub 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. |
31 | sub _can_accessor_name_for { |
32 | my $class = shift; |
2d8ced39 |
33 | return $class->can("accessor_name_for") || $class->can("accessor_name"); |
e60dc79f |
34 | } |
35 | |
36 | sub _can_mutator_name_for { |
37 | my $class = shift; |
2d8ced39 |
38 | return $class->can("mutator_name_for") || $class->can("mutator_name"); |
e60dc79f |
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 | |
75a23b3e |
58 | sub 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 |
74 | 1; |