1 package DBIx::Class::AccessorGroup;
6 use base qw/Class::Data::Inheritable/;
9 __PACKAGE__->mk_classdata('_accessor_group_deleted' => { });
11 sub mk_group_accessors {
12 my($self, $group, @fields) = @_;
14 $self->_mk_group_accessors('make_group_accessor', $group, @fields);
20 no warnings 'redefine';
22 sub _mk_group_accessors {
23 my($self, $maker, $group, @fields) = @_;
24 my $class = ref $self || $self;
26 # So we don't have to do lots of lookups inside the loop.
27 $maker = $self->can($maker) unless ref $maker;
29 foreach my $field (@fields) {
30 if( $field eq 'DESTROY' ) {
32 &Carp::carp("Having a data accessor named DESTROY in ".
33 "'$class' is unwise.");
38 ($name, $field) = @$field if ref $field;
40 my $accessor = $self->$maker($group, $field);
41 my $alias = "_${name}_accessor";
43 #warn "$class $group $field $alias";
45 *{$class."\:\:$name"} = $accessor;
46 #unless defined &{$class."\:\:$field"}
48 *{$class."\:\:$alias"} = $accessor;
49 #unless defined &{$class."\:\:$alias"}
54 sub mk_group_ro_accessors {
55 my($self, $group, @fields) = @_;
57 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
60 sub mk_group_wo_accessors {
61 my($self, $group, @fields) = @_;
63 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
66 sub make_group_accessor {
67 my ($class, $group, $field) = @_;
69 my $set = "set_$group";
70 my $get = "get_$group";
72 # Build a closure around $field.
77 return $self->$set($field, @_);
80 return $self->$get($field);
85 sub make_group_ro_accessor {
86 my($class, $group, $field) = @_;
88 my $get = "get_$group";
96 Carp::croak("'$caller' cannot alter the value of '$field' on ".
97 "objects of class '$class'");
100 return $self->$get($field);
105 sub make_group_wo_accessor {
106 my($class, $group, $field) = @_;
108 my $set = "set_$group";
116 Carp::croak("'$caller' cannot access the value of '$field' on ".
117 "objects of class '$class'");
120 return $self->$set($field, @_);
125 sub delete_accessor {
126 my ($class, $accessor) = @_;
127 $class = ref $class if ref $class;
128 my $sym = "${class}::${accessor}";
130 delete $DB::sub{$sym};
131 #$class->_accessor_group_deleted->{"${class}::${accessor}"} = 1;