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.");
35 my $accessor = $self->$maker($group, $field);
36 my $alias = "_${field}_accessor";
38 #warn "$class $group $field $alias";
40 *{$class."\:\:$field"} = $accessor;
41 #unless defined &{$class."\:\:$field"}
43 *{$class."\:\:$alias"} = $accessor;
44 #unless defined &{$class."\:\:$alias"}
49 sub mk_group_ro_accessors {
50 my($self, $group, @fields) = @_;
52 $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
55 sub mk_group_wo_accessors {
56 my($self, $group, @fields) = @_;
58 $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
61 sub make_group_accessor {
62 my ($class, $group, $field) = @_;
64 my $set = "set_$group";
65 my $get = "get_$group";
67 # Build a closure around $field.
72 return $self->$set($field, @_);
75 return $self->$get($field);
80 sub make_group_ro_accessor {
81 my($class, $group, $field) = @_;
83 my $get = "get_$group";
91 Carp::croak("'$caller' cannot alter the value of '$field' on ".
92 "objects of class '$class'");
95 return $self->$get($field);
100 sub make_group_wo_accessor {
101 my($class, $group, $field) = @_;
103 my $set = "set_$group";
111 Carp::croak("'$caller' cannot access the value of '$field' on ".
112 "objects of class '$class'");
115 return $self->$set($field, @_);
120 sub delete_accessor {
121 my ($class, $accessor) = @_;
122 $class = ref $class if ref $class;
123 my $sym = "${class}::${accessor}";
125 delete $DB::sub{$sym};
126 #$class->_accessor_group_deleted->{"${class}::${accessor}"} = 1;