X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=4478f413ae6ec2f50a04974489abeb90257b396e;hb=c812d1fc5872e623f2c4984925345cb1ccaa5f52;hp=dd99da3a9696eabd336bf1285c1fdd95dbf21393;hpb=dec2517f954b8c6053570a6b5ecf08fbaf1a2bc2;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index dd99da3..4478f41 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -5,7 +5,7 @@ use warnings; use Carp::Clan qw/^DBIx::Class/; -=head1 NAME +=head1 NAME DBIx::Class::AccessorGroup - Lets you build groups of accessors @@ -18,12 +18,32 @@ getters and setters. =head1 METHODS +=head2 mk_group_accessors + +=over 4 + +=item Arguments: $group, @fieldspec + +Returns: none + +=back + +Creates a set of accessors in a given group. + +$group is the name of the accessor group for the generated accessors; they +will call get_$group($field) on get and set_$group($field, $value) on set. + +@fieldspec is a list of field/accessor names; if a fieldspec is a scalar +this is used as both field and accessor name, if a listref it is expected to +be of the form [ $accessor, $field ]. + =cut sub mk_group_accessors { - my($self, $group, @fields) = @_; + my ($self, $group, @fields) = @_; - $self->_mk_group_accessors('make_group_accessor', $group, @fields); + $self->_mk_group_accessors('make_group_accessor', $group, @fields); + return; } @@ -62,18 +82,65 @@ sub mk_group_accessors { } } +=head2 mk_group_ro_accessors + +=over 4 + +=item Arguments: $group, @fieldspec + +Returns: none + +=back + +Creates a set of read only accessors in a given group. Identical to + but accessors will throw an error if passed a value +rather than setting the value. + +=cut + sub mk_group_ro_accessors { my($self, $group, @fields) = @_; $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); } +=head2 mk_group_wo_accessors + +=over 4 + +=item Arguments: $group, @fieldspec + +Returns: none + +=back + +Creates a set of write only accessors in a given group. Identical to + but accessors will throw an error if not passed a +value rather than getting the value. + +=cut + sub mk_group_wo_accessors { my($self, $group, @fields) = @_; $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); } +=head2 make_group_accessor + +=over 4 + +=item Arguments: $group, $field + +Returns: $sub (\CODE) + +=back + +Returns a single accessor in a given group; called by mk_group_accessors +for each entry in @fieldspec. + +=cut + sub make_group_accessor { my ($class, $group, $field) = @_; @@ -93,6 +160,21 @@ sub make_group_accessor { }; } +=head2 make_group_ro_accessor + +=over 4 + +=item Arguments: $group, $field + +Returns: $sub (\CODE) + +=back + +Returns a single read-only accessor in a given group; called by +mk_group_ro_accessors for each entry in @fieldspec. + +=cut + sub make_group_ro_accessor { my($class, $group, $field) = @_; @@ -112,6 +194,21 @@ sub make_group_ro_accessor { }; } +=head2 make_group_wo_accessor + +=over 4 + +=item Arguments: $group, $field + +Returns: $sub (\CODE) + +=back + +Returns a single write-only accessor in a given group; called by +mk_group_wo_accessors for each entry in @fieldspec. + +=cut + sub make_group_wo_accessor { my($class, $group, $field) = @_; @@ -131,26 +228,88 @@ sub make_group_wo_accessor { }; } +=head2 get_simple + +=over 4 + +=item Arguments: $field + +Returns: $value + +=back + +Simple getter for hash-based objects which returns the value for the field +name passed as an argument. + +=cut + sub get_simple { my ($self, $get) = @_; return $self->{$get}; } +=head2 set_simple + +=over 4 + +=item Arguments: $field, $new_value + +Returns: $new_value + +=back + +Simple setter for hash-based objects which sets and then returns the value +for the field name passed as an argument. + +=cut + sub set_simple { my ($self, $set, $val) = @_; return $self->{$set} = $val; } +=head2 get_component_class + +=over 4 + +=item Arguments: $name + +Returns: $component_class + +=back + +Returns the class name for a component; returns an object key if called on +an object, or attempts to return classdata referenced by _$name if called +on a class. + +=cut + sub get_component_class { my ($self, $get) = @_; if (ref $self) { return $self->{$get}; } else { $get = "_$get"; - return $self->can($get) ? $self->$get : undef; + return $self->can($get) ? $self->$get : undef; } } +=head2 set_component_class + +=over 4 + +=item Arguments: $name, $new_component_class + +Returns: $new_component_class + +=back + +Sets a component class name; attempts to require the class before setting +but does not error if unable to do so. Sets an object key of the given name +if called or an object or classdata called _$name if called on a class. + +=cut + sub set_component_class { my ($self, $set, $val) = @_; eval "require $val"; @@ -158,8 +317,10 @@ sub set_component_class { return $self->{$set} = $val; } else { $set = "_$set"; - return $self->can($set) ? $self->$set($val) : $self->mk_classdata($set => $val); - } + return $self->can($set) ? + $self->$set($val) : + $self->mk_classdata($set => $val); + } } 1;