X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=a4ceff83f37068cacd4c9ab69238c57a89b86903;hb=cd80a31c5adb769ee4f0cfda4f6749cd04c1b511;hp=4e42b2777ca2885750a242327badecd4b5d83695;hpb=fc9690056f17278f057021803b1124ebbd5a0d2d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index 4e42b27..a4ceff8 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -18,12 +18,28 @@ getters and setters. =head1 METHODS +=head2 mk_group_accessors + +Creates a set of accessors in a given group. + +=head3 Arguments: $group, @fieldspec + +$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 ]. + +=head3 Return value: none + =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 +78,53 @@ sub mk_group_accessors { } } +=head2 mk_group_ro_accessors + +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. + +=head3 Arguments: $group, @fieldspec + +=head3 Return value: none + +=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 + +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. + +=head3 Arguments: $group, @fieldspec + +=head3 Return value: none + +=cut + sub mk_group_wo_accessors { my($self, $group, @fields) = @_; $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); } +=head2 make_group_accessor + +Returns a single accessor in a given group; called by mk_group_accessors +for each entry in @fieldspec. + +=head3 Arguments: $group, $field + +=head3 Return value: $sub (\CODE) + +=cut + sub make_group_accessor { my ($class, $group, $field) = @_; @@ -93,6 +144,17 @@ sub make_group_accessor { }; } +=head2 make_group_ro_accessor + +Returns a single read-only accessor in a given group; called by +mk_group_ro_accessors for each entry in @fieldspec. + +=head3 Arguments: $group, $field + +=head3 Return value: $sub (\CODE) + +=cut + sub make_group_ro_accessor { my($class, $group, $field) = @_; @@ -112,6 +174,17 @@ sub make_group_ro_accessor { }; } +=head2 make_group_wo_accessor + +Returns a single write-only accessor in a given group; called by +mk_group_wo_accessors for each entry in @fieldspec. + +=head3 Arguments: $group, $field + +=head3 Return value: $sub (\CODE) + +=cut + sub make_group_wo_accessor { my($class, $group, $field) = @_; @@ -122,7 +195,6 @@ sub make_group_wo_accessor { unless (@_) { my $caller = caller; - require Carp; croak("'$caller' cannot access the value of '$field' on ". "objects of class '$class'"); } @@ -132,16 +204,50 @@ sub make_group_wo_accessor { }; } +=head2 get_simple + +Simple getter for hash-based objects which returns the value for the field +name passed as an argument. + +=head3 Arguments: $field + +=head3 Return value: $value + +=cut + sub get_simple { my ($self, $get) = @_; return $self->{$get}; } +=head2 set_simple + +Simple setter for hash-based objects which sets and then returns the value +for the field name passed as an argument. + +=head3 Arguments: $field, $new_value + +=head3 Return value: $new_value + +=cut + sub set_simple { my ($self, $set, $val) = @_; return $self->{$set} = $val; } +=head2 get_component_class + +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. + +=head3 Arguments: $name + +=head3 Return value: $component_class + +=cut + sub get_component_class { my ($self, $get) = @_; if (ref $self) { @@ -152,6 +258,18 @@ sub get_component_class { } } +=head2 set_component_class + +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. + +=head3 Arguments: $name, $new_component_class + +=head3 Return value: $new_component_class + +=cut + sub set_component_class { my ($self, $set, $val) = @_; eval "require $val";