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