1 package DBIx::Class::AccessorGroup;
8 DBIx::Class::AccessorGroup - Lets you build groups of accessors
14 This class lets you build groups of accessors that will call different
23 sub mk_group_accessors {
24 my($self, $group, @fields) = @_;
26 $self->_mk_group_accessors('make_group_accessor', $group, @fields);
32 no warnings 'redefine';
34 sub _mk_group_accessors {
35 my($self, $maker, $group, @fields) = @_;
36 my $class = ref $self || $self;
38 # So we don't have to do lots of lookups inside the loop.
39 $maker = $self->can($maker) unless ref $maker;
41 foreach my $field (@fields) {
42 if( $field eq 'DESTROY' ) {
44 &Carp::carp("Having a data accessor named DESTROY in ".
45 "'$class' is unwise.");
50 ($name, $field) = @$field if ref $field;
52 my $accessor = $self->$maker($group, $field);
53 my $alias = "_${name}_accessor";
55 #warn "$class $group $field $alias";
57 *{$class."\:\:$name"} = $accessor;
58 #unless defined &{$class."\:\:$field"}
60 *{$class."\:\:$alias"} = $accessor;
61 #unless defined &{$class."\:\:$alias"}
66 sub mk_group_ro_accessors {
67 my($self, $group, @fields) = @_;
69 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
72 sub mk_group_wo_accessors {
73 my($self, $group, @fields) = @_;
75 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
78 sub make_group_accessor {
79 my ($class, $group, $field) = @_;
81 my $set = "set_$group";
82 my $get = "get_$group";
84 # Build a closure around $field.
89 return $self->$set($field, @_);
92 return $self->$get($field);
97 sub make_group_ro_accessor {
98 my($class, $group, $field) = @_;
100 my $get = "get_$group";
108 Carp::croak("'$caller' cannot alter the value of '$field' on ".
109 "objects of class '$class'");
112 return $self->$get($field);
117 sub make_group_wo_accessor {
118 my($class, $group, $field) = @_;
120 my $set = "set_$group";
128 Carp::croak("'$caller' cannot access the value of '$field' on ".
129 "objects of class '$class'");
132 return $self->$set($field, @_);
138 my ($self, $get) = @_;
139 return $self->{$get};
143 my ($self, $set, $val) = @_;
144 return $self->{$set} = $val;
153 Matt S. Trout <mst@shadowcatsystems.co.uk>
157 You may distribute this code under the same terms as Perl itself.