1 package DBIx::Class::AccessorGroup;
6 use Carp::Clan qw/^DBIx::Class/;
10 DBIx::Class::AccessorGroup - Lets you build groups of accessors
16 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' ) {
43 carp("Having a data accessor named DESTROY in ".
44 "'$class' is unwise.");
49 ($name, $field) = @$field if ref $field;
51 my $accessor = $self->$maker($group, $field);
52 my $alias = "_${name}_accessor";
54 #warn "$class $group $field $alias";
56 *{$class."\:\:$name"} = $accessor;
57 #unless defined &{$class."\:\:$field"}
59 *{$class."\:\:$alias"} = $accessor;
60 #unless defined &{$class."\:\:$alias"}
65 sub mk_group_ro_accessors {
66 my($self, $group, @fields) = @_;
68 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
71 sub mk_group_wo_accessors {
72 my($self, $group, @fields) = @_;
74 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
77 sub make_group_accessor {
78 my ($class, $group, $field) = @_;
80 my $set = "set_$group";
81 my $get = "get_$group";
83 # Build a closure around $field.
88 return $self->$set($field, @_);
91 return $self->$get($field);
96 sub make_group_ro_accessor {
97 my($class, $group, $field) = @_;
99 my $get = "get_$group";
106 croak("'$caller' cannot alter the value of '$field' on ".
107 "objects of class '$class'");
110 return $self->$get($field);
115 sub make_group_wo_accessor {
116 my($class, $group, $field) = @_;
118 my $set = "set_$group";
126 croak("'$caller' cannot access the value of '$field' on ".
127 "objects of class '$class'");
130 return $self->$set($field, @_);
136 my ($self, $get) = @_;
137 return $self->{$get};
141 my ($self, $set, $val) = @_;
142 return $self->{$set} = $val;
149 Matt S. Trout <mst@shadowcatsystems.co.uk>
153 You may distribute this code under the same terms as Perl itself.