1 package Class::Accessor::Grouped;
11 Class:Accessor::Grouped- Lets you build groups of accessors
17 This class lets you build groups of accessors that will call different
22 =head2 mk_group_accessors
26 =item Arguments: $group, @fieldspec
32 Creates a set of accessors in a given group.
34 $group is the name of the accessor group for the generated accessors; they
35 will call get_$group($field) on get and set_$group($field, $value) on set.
37 @fieldspec is a list of field/accessor names; if a fieldspec is a scalar
38 this is used as both field and accessor name, if a listref it is expected to
39 be of the form [ $accessor, $field ].
43 sub mk_group_accessors {
44 my ($self, $group, @fields) = @_;
46 $self->_mk_group_accessors('make_group_accessor', $group, @fields);
53 no warnings 'redefine';
55 sub _mk_group_accessors {
56 my($self, $maker, $group, @fields) = @_;
57 my $class = ref $self || $self;
59 # So we don't have to do lots of lookups inside the loop.
60 $maker = $self->can($maker) unless ref $maker;
62 foreach my $field (@fields) {
63 if( $field eq 'DESTROY' ) {
64 carp("Having a data accessor named DESTROY in ".
65 "'$class' is unwise.");
70 ($name, $field) = @$field if ref $field;
72 my $accessor = $self->$maker($group, $field);
73 my $alias = "_${name}_accessor";
75 #warn "$class $group $field $alias";
77 *{$class."\:\:$name"} = $accessor;
78 #unless defined &{$class."\:\:$field"}
80 *{$class."\:\:$alias"} = $accessor;
81 #unless defined &{$class."\:\:$alias"}
86 =head2 mk_group_ro_accessors
90 =item Arguments: $group, @fieldspec
96 Creates a set of read only accessors in a given group. Identical to
97 <L:/mk_group_accessors> but accessors will throw an error if passed a value
98 rather than setting the value.
102 sub mk_group_ro_accessors {
103 my($self, $group, @fields) = @_;
105 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
108 =head2 mk_group_wo_accessors
112 =item Arguments: $group, @fieldspec
118 Creates a set of write only accessors in a given group. Identical to
119 <L:/mk_group_accessors> but accessors will throw an error if not passed a
120 value rather than getting the value.
124 sub mk_group_wo_accessors {
125 my($self, $group, @fields) = @_;
127 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
130 =head2 make_group_accessor
134 =item Arguments: $group, $field
136 Returns: $sub (\CODE)
140 Returns a single accessor in a given group; called by mk_group_accessors
141 for each entry in @fieldspec.
145 sub make_group_accessor {
146 my ($class, $group, $field) = @_;
148 my $set = "set_$group";
149 my $get = "get_$group";
151 # Build a closure around $field.
156 return $self->$set($field, @_);
159 return $self->$get($field);
164 =head2 make_group_ro_accessor
168 =item Arguments: $group, $field
170 Returns: $sub (\CODE)
174 Returns a single read-only accessor in a given group; called by
175 mk_group_ro_accessors for each entry in @fieldspec.
179 sub make_group_ro_accessor {
180 my($class, $group, $field) = @_;
182 my $get = "get_$group";
189 croak("'$caller' cannot alter the value of '$field' on ".
190 "objects of class '$class'");
193 return $self->$get($field);
198 =head2 make_group_wo_accessor
202 =item Arguments: $group, $field
204 Returns: $sub (\CODE)
208 Returns a single write-only accessor in a given group; called by
209 mk_group_wo_accessors for each entry in @fieldspec.
213 sub make_group_wo_accessor {
214 my($class, $group, $field) = @_;
216 my $set = "set_$group";
223 croak("'$caller' cannot access the value of '$field' on ".
224 "objects of class '$class'");
227 return $self->$set($field, @_);
236 =item Arguments: $field
242 Simple getter for hash-based objects which returns the value for the field
243 name passed as an argument.
248 my ($self, $get) = @_;
249 return $self->{$get};
256 =item Arguments: $field, $new_value
262 Simple setter for hash-based objects which sets and then returns the value
263 for the field name passed as an argument.
268 my ($self, $set, $val) = @_;
269 return $self->{$set} = $val;
276 Matt S. Trout <mst@shadowcatsystems.co.uk>
280 You may distribute this code under the same terms as Perl itself.