1 package DBIx::Class::AccessorGroup;
6 use base qw/Class::Data::Inheritable/;
8 __PACKAGE__->mk_classdata('_accessor_group_deleted' => { });
10 sub mk_group_accessors {
11 my($self, $group, @fields) = @_;
13 $self->_mk_group_accessors('make_group_accessor', $group, @fields);
19 no warnings 'redefine';
21 sub _mk_group_accessors {
22 my($self, $maker, $group, @fields) = @_;
23 my $class = ref $self || $self;
25 # So we don't have to do lots of lookups inside the loop.
26 $maker = $self->can($maker) unless ref $maker;
28 foreach my $field (@fields) {
29 if( $field eq 'DESTROY' ) {
31 &Carp::carp("Having a data accessor named DESTROY in ".
32 "'$class' is unwise.");
37 ($name, $field) = @$field if ref $field;
39 my $accessor = $self->$maker($group, $field);
40 my $alias = "_${name}_accessor";
42 #warn "$class $group $field $alias";
44 *{$class."\:\:$name"} = $accessor;
45 #unless defined &{$class."\:\:$field"}
47 *{$class."\:\:$alias"} = $accessor;
48 #unless defined &{$class."\:\:$alias"}
53 sub mk_group_ro_accessors {
54 my($self, $group, @fields) = @_;
56 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
59 sub mk_group_wo_accessors {
60 my($self, $group, @fields) = @_;
62 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
65 sub make_group_accessor {
66 my ($class, $group, $field) = @_;
68 my $set = "set_$group";
69 my $get = "get_$group";
71 # Build a closure around $field.
76 return $self->$set($field, @_);
79 return $self->$get($field);
84 sub make_group_ro_accessor {
85 my($class, $group, $field) = @_;
87 my $get = "get_$group";
95 Carp::croak("'$caller' cannot alter the value of '$field' on ".
96 "objects of class '$class'");
99 return $self->$get($field);
104 sub make_group_wo_accessor {
105 my($class, $group, $field) = @_;
107 my $set = "set_$group";
115 Carp::croak("'$caller' cannot access the value of '$field' on ".
116 "objects of class '$class'");
119 return $self->$set($field, @_);
124 sub delete_accessor {
125 my ($class, $accessor) = @_;
126 $class = ref $class if ref $class;
127 my $sym = "${class}::${accessor}";
129 delete $DB::sub{$sym};
130 #$class->_accessor_group_deleted->{"${class}::${accessor}"} = 1;