package DBIx::Class::AccessorGroup;
+use strict;
+use warnings;
+
+use base qw/Class::Data::Inheritable/;
+
+__PACKAGE__->mk_classdata('_accessor_group_deleted' => { });
+
sub mk_group_accessors {
my($self, $group, @fields) = @_;
{
no strict 'refs';
+ no warnings 'redefine';
sub _mk_group_accessors {
my($self, $maker, $group, @fields) = @_;
my $accessor = $self->$maker($group, $field);
my $alias = "_${field}_accessor";
- *{$class."\:\:$field"} = $accessor
- unless defined &{$class."\:\:$field"};
+ #warn "$class $group $field $alias";
- *{$class."\:\:$alias"} = $accessor
- unless defined &{$class."\:\:$alias"};
+ *{$class."\:\:$field"} = $accessor;
+ #unless defined &{$class."\:\:$field"}
+
+ *{$class."\:\:$alias"} = $accessor;
+ #unless defined &{$class."\:\:$alias"}
}
}
}
my $self = shift;
if(@_) {
- return $self->set($field, @_);
+ return $self->$set($field, @_);
}
else {
- return $self->get($field);
+ return $self->$get($field);
}
};
}
"objects of class '$class'");
}
else {
- return $self->get($field);
+ return $self->$get($field);
}
};
}
"objects of class '$class'");
}
else {
- return $self->set($field, @_);
+ return $self->$set($field, @_);
}
};
}
+sub delete_accessor {
+ my ($class, $accessor) = @_;
+ $class = ref $class if ref $class;
+ my $sym = "${class}::${accessor}";
+ undef &$sym;
+ delete $DB::sub{$sym};
+ #$class->_accessor_group_deleted->{"${class}::${accessor}"} = 1;
+}
+
1;