And now really untabify
[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) = @_;
05ccf064 9
ea2e61bf 10 foreach my $col (@cols) {
05ccf064 11 my $ro_meth = $class->accessor_name_for($col);
12 my $wo_meth = $class->mutator_name_for($col);
e60dc79f 13
14 # warn "class: $class / col: $col / ro: $ro_meth / wo: $wo_meth\n";
15 if ($ro_meth eq $wo_meth or # they're the same
16 $wo_meth eq $col) # or only the accessor is custom
17 {
147dd158 18 $class->next::method($group => [ $ro_meth => $col ]);
ea2e61bf 19 } else {
b8e1e21f 20 $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
21 $class->mk_group_wo_accessors($group => [ $wo_meth => $col ]);
ea2e61bf 22 }
23 }
24}
25
e60dc79f 26
05ccf064 27sub accessor_name_for {
28 my ($class, $column) = @_;
29 if ($class->can('accessor_name')) {
30 return $class->accessor_name($column)
31 }
e60dc79f 32
05ccf064 33 return $column;
e60dc79f 34}
35
05ccf064 36sub mutator_name_for {
37 my ($class, $column) = @_;
38 if ($class->can('mutator_name')) {
39 return $class->mutator_name($column)
40 }
e60dc79f 41
05ccf064 42 return $column;
e60dc79f 43}
44
45
75a23b3e 46sub new {
9bc6db13 47 my ($class, $attrs, @rest) = @_;
701da8c4 48 $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
103647d5 49 foreach my $col ($class->columns) {
05ccf064 50 my $acc = $class->accessor_name_for($col);
75a23b3e 51 $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
05ccf064 52
53 my $mut = $class->mutator_name_for($col);
75a23b3e 54 $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
9bc6db13 55 }
75a23b3e 56 return $class->next::method($attrs, @rest);
9bc6db13 57}
58
ea2e61bf 591;