X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=4d7e0469096d10caf215aa52e884703cee4e08b2;hb=a50c9d6098b35b2a0a67d85ef4b154b265f5b752;hp=bfaef4d0b24907a051c5947c9fdecf4d53d7637c;hpb=b8e1e21f0fcd55e6e3ce987e57601b279a75b666;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index bfaef4d..4d7e046 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -3,131 +3,27 @@ package DBIx::Class::AccessorGroup; use strict; use warnings; -use base qw/Class::Data::Inheritable/; +use base qw/Class::Accessor::Grouped/; -__PACKAGE__->mk_classdata('_accessor_group_deleted' => { }); - -sub mk_group_accessors { - my($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_accessor', $group, @fields); -} - - -{ - no strict 'refs'; - no warnings 'redefine'; - - sub _mk_group_accessors { - my($self, $maker, $group, @fields) = @_; - my $class = ref $self || $self; - - # So we don't have to do lots of lookups inside the loop. - $maker = $self->can($maker) unless ref $maker; - - foreach my $field (@fields) { - if( $field eq 'DESTROY' ) { - require Carp; - &Carp::carp("Having a data accessor named DESTROY in ". - "'$class' is unwise."); - } - - my $name = $field; - - ($name, $field) = @$field if ref $field; - - my $accessor = $self->$maker($group, $field); - my $alias = "_${name}_accessor"; - - #warn "$class $group $field $alias"; - - *{$class."\:\:$name"} = $accessor; - #unless defined &{$class."\:\:$field"} - - *{$class."\:\:$alias"} = $accessor; - #unless defined &{$class."\:\:$alias"} - } - } -} - -sub mk_group_ro_accessors { - my($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); -} - -sub mk_group_wo_accessors { - my($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); -} - -sub make_group_accessor { - my ($class, $group, $field) = @_; - - my $set = "set_$group"; - my $get = "get_$group"; - - # Build a closure around $field. - return sub { - my $self = shift; +1; - if(@_) { - return $self->$set($field, @_); - } - else { - return $self->$get($field); - } - }; -} +=head1 NAME -sub make_group_ro_accessor { - my($class, $group, $field) = @_; +DBIx::Class::AccessorGroup - See Class::Accessor::Grouped - my $get = "get_$group"; +=head1 SYNOPSIS - return sub { - my $self = shift; +=head1 DESCRIPTION - if(@_) { - my $caller = caller; - require Carp; - Carp::croak("'$caller' cannot alter the value of '$field' on ". - "objects of class '$class'"); - } - else { - return $self->$get($field); - } - }; -} +This class now exists in its own right on CPAN as Class::Accessor::Grouped -sub make_group_wo_accessor { - my($class, $group, $field) = @_; +=head1 AUTHORS - my $set = "set_$group"; +Matt S. Trout - return sub { - my $self = shift; +=head1 LICENSE - unless (@_) { - my $caller = caller; - require Carp; - Carp::croak("'$caller' cannot access the value of '$field' on ". - "objects of class '$class'"); - } - else { - return $self->$set($field, @_); - } - }; -} +You may distribute this code under the same terms as Perl itself. -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; -} +=cut -1;