Commit | Line | Data |
fe5d862b |
1 | package DBIx::Class::AccessorGroup; |
2 | |
12bbb339 |
3 | use strict; |
4 | use warnings; |
5 | |
604d9f38 |
6 | use NEXT; |
12bbb339 |
7 | |
fe5d862b |
8 | sub mk_group_accessors { |
9 | my($self, $group, @fields) = @_; |
10 | |
11 | $self->_mk_group_accessors('make_group_accessor', $group, @fields); |
12 | } |
13 | |
14 | |
15 | { |
16 | no strict 'refs'; |
12bbb339 |
17 | no warnings 'redefine'; |
fe5d862b |
18 | |
19 | sub _mk_group_accessors { |
20 | my($self, $maker, $group, @fields) = @_; |
21 | my $class = ref $self || $self; |
22 | |
23 | # So we don't have to do lots of lookups inside the loop. |
24 | $maker = $self->can($maker) unless ref $maker; |
25 | |
26 | foreach my $field (@fields) { |
27 | if( $field eq 'DESTROY' ) { |
28 | require Carp; |
29 | &Carp::carp("Having a data accessor named DESTROY in ". |
30 | "'$class' is unwise."); |
31 | } |
32 | |
b8e1e21f |
33 | my $name = $field; |
34 | |
35 | ($name, $field) = @$field if ref $field; |
36 | |
fe5d862b |
37 | my $accessor = $self->$maker($group, $field); |
b8e1e21f |
38 | my $alias = "_${name}_accessor"; |
fe5d862b |
39 | |
12bbb339 |
40 | #warn "$class $group $field $alias"; |
fe5d862b |
41 | |
b8e1e21f |
42 | *{$class."\:\:$name"} = $accessor; |
12bbb339 |
43 | #unless defined &{$class."\:\:$field"} |
44 | |
45 | *{$class."\:\:$alias"} = $accessor; |
46 | #unless defined &{$class."\:\:$alias"} |
fe5d862b |
47 | } |
48 | } |
49 | } |
50 | |
51 | sub mk_group_ro_accessors { |
52 | my($self, $group, @fields) = @_; |
53 | |
54 | $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); |
55 | } |
56 | |
57 | sub mk_group_wo_accessors { |
58 | my($self, $group, @fields) = @_; |
59 | |
60 | $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); |
61 | } |
62 | |
63 | sub make_group_accessor { |
64 | my ($class, $group, $field) = @_; |
65 | |
66 | my $set = "set_$group"; |
67 | my $get = "get_$group"; |
68 | |
69 | # Build a closure around $field. |
70 | return sub { |
71 | my $self = shift; |
72 | |
73 | if(@_) { |
12bbb339 |
74 | return $self->$set($field, @_); |
fe5d862b |
75 | } |
76 | else { |
12bbb339 |
77 | return $self->$get($field); |
fe5d862b |
78 | } |
79 | }; |
80 | } |
81 | |
82 | sub make_group_ro_accessor { |
83 | my($class, $group, $field) = @_; |
84 | |
85 | my $get = "get_$group"; |
86 | |
87 | return sub { |
88 | my $self = shift; |
89 | |
90 | if(@_) { |
91 | my $caller = caller; |
92 | require Carp; |
93 | Carp::croak("'$caller' cannot alter the value of '$field' on ". |
94 | "objects of class '$class'"); |
95 | } |
96 | else { |
12bbb339 |
97 | return $self->$get($field); |
fe5d862b |
98 | } |
99 | }; |
100 | } |
101 | |
102 | sub make_group_wo_accessor { |
103 | my($class, $group, $field) = @_; |
104 | |
105 | my $set = "set_$group"; |
106 | |
107 | return sub { |
108 | my $self = shift; |
109 | |
110 | unless (@_) { |
111 | my $caller = caller; |
112 | require Carp; |
113 | Carp::croak("'$caller' cannot access the value of '$field' on ". |
114 | "objects of class '$class'"); |
115 | } |
116 | else { |
12bbb339 |
117 | return $self->$set($field, @_); |
fe5d862b |
118 | } |
119 | }; |
120 | } |
121 | |
122 | 1; |