X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=dd99da3a9696eabd336bf1285c1fdd95dbf21393;hb=dec2517f954b8c6053570a6b5ecf08fbaf1a2bc2;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..dd99da3 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -3,9 +3,22 @@ package DBIx::Class::AccessorGroup; use strict; use warnings; -use base qw/Class::Data::Inheritable/; +use Carp::Clan qw/^DBIx::Class/; -__PACKAGE__->mk_classdata('_accessor_group_deleted' => { }); +=head1 NAME + +DBIx::Class::AccessorGroup - Lets you build groups of accessors + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This class lets you build groups of accessors that will call different +getters and setters. + +=head1 METHODS + +=cut sub mk_group_accessors { my($self, $group, @fields) = @_; @@ -27,8 +40,7 @@ sub mk_group_accessors { foreach my $field (@fields) { if( $field eq 'DESTROY' ) { - require Carp; - &Carp::carp("Having a data accessor named DESTROY in ". + carp("Having a data accessor named DESTROY in ". "'$class' is unwise."); } @@ -91,8 +103,7 @@ sub make_group_ro_accessor { if(@_) { my $caller = caller; - require Carp; - Carp::croak("'$caller' cannot alter the value of '$field' on ". + croak("'$caller' cannot alter the value of '$field' on ". "objects of class '$class'"); } else { @@ -111,8 +122,7 @@ sub make_group_wo_accessor { unless (@_) { my $caller = caller; - require Carp; - Carp::croak("'$caller' cannot access the value of '$field' on ". + croak("'$caller' cannot access the value of '$field' on ". "objects of class '$class'"); } else { @@ -121,13 +131,46 @@ sub make_group_wo_accessor { }; } -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; +sub get_simple { + my ($self, $get) = @_; + return $self->{$get}; +} + +sub set_simple { + my ($self, $set, $val) = @_; + return $self->{$set} = $val; +} + +sub get_component_class { + my ($self, $get) = @_; + if (ref $self) { + return $self->{$get}; + } else { + $get = "_$get"; + return $self->can($get) ? $self->$get : undef; + } +} + +sub set_component_class { + my ($self, $set, $val) = @_; + eval "require $val"; + if (ref $self) { + return $self->{$set} = $val; + } else { + $set = "_$set"; + return $self->can($set) ? $self->$set($val) : $self->mk_classdata($set => $val); + } } 1; + +=head1 AUTHORS + +Matt S. Trout + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut +