From: Christopher H. Laco Date: Wed, 9 May 2007 01:55:34 +0000 (+0000) Subject: Added get/set_component_class X-Git-Tag: v0.05000^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=331e820d3229ade6282aaaba4c307d7a016e8c73;p=p5sagit%2FClass-Accessor-Grouped.git Added get/set_component_class --- diff --git a/Changes b/Changes index cd365bc..4e041a0 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for Class::Accessor::Grouped. +0.05000 Tue May 08 19:42:33 2007 + - Added get/set_component_class + 0 04000 Sat May 05 21:17:23 2007 - Converted to Module::Install - Added culterific tests/TEST_AUTHOR diff --git a/Makefile.PL b/Makefile.PL index 449ad45..c4c4384 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -11,6 +11,7 @@ all_from 'lib/Class/Accessor/Grouped.pm'; requires 'Carp'; requires 'Scalar::Util'; requires 'Class::ISA'; +requires 'Class::Inspector'; tests "t/*.t t/*/*.t"; clean_files "Class-Accessor-Grouped-* t/var"; diff --git a/README b/README index 2f94656..77cd081 100644 --- a/README +++ b/README @@ -94,6 +94,32 @@ METHODS Note:: This method will die if you try to set an object variable on a non hash-based object. + get_component_class + Arguments: $field + Returns: $value + + Gets the value of the specified component class. + + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + + $self->result_class->method(); + + ## same as + $self->get_component_class('result_class')->method(); + + set_component_class + Arguments: $field, $class + Returns: $new_value + + Inherited accessor that automatically loads the specified class before + setting it. This method will die if the specified class could not be + loaded. + + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + __PACKAGE__->result_class('MyClass'); + + $self->result_class->method(); + get_super_paths Returns a list of 'parent' or 'super' class names that the current class inherited from. diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm index 978ff1d..6a317ed 100644 --- a/lib/Class/Accessor/Grouped.pm +++ b/lib/Class/Accessor/Grouped.pm @@ -2,11 +2,13 @@ package Class::Accessor::Grouped; use strict; use warnings; use Carp; -use Class::ISA; -use Scalar::Util qw/blessed reftype/; +use Class::Inspector (); +use Class::ISA (); +use Scalar::Util (); + use vars qw($VERSION); -$VERSION = '0.04000'; +$VERSION = '0.05000'; =head1 NAME @@ -56,7 +58,7 @@ sub mk_group_accessors { sub _mk_group_accessors { my($self, $maker, $group, @fields) = @_; - my $class = ref $self || $self; + my $class = Scalar::Util::blessed($self) || $self; # So we don't have to do lots of lookups inside the loop. $maker = $self->can($maker) unless ref $maker; @@ -74,8 +76,6 @@ sub mk_group_accessors { my $accessor = $self->$maker($group, $field); my $alias = "_${name}_accessor"; - #warn "$class $group $field $alias"; - *{$class."\:\:$name"} = $accessor; #unless defined &{$class."\:\:$field"} @@ -282,9 +282,11 @@ Returns: $value =back -Simple getter for Classes and hash-based objects which returns the value for the field name passed as -an argument. This behaves much like L where the field can be set in a -base class, inherited and changed in subclasses, and inherited and changed for object instances. +Simple getter for Classes and hash-based objects which returns the value for +the field name passed as an argument. This behaves much like +L where the field can be set in a base class, +inherited and changed in subclasses, and inherited and changed for object +instances. =cut @@ -292,8 +294,8 @@ sub get_inherited { my ($self, $get) = @_; my $class; - if (blessed $self) { - my $reftype = reftype $self; + if (Scalar::Util::blessed($self)) { + my $reftype = Scalar::Util::reftype($self); $class = ref $self; if ($reftype eq 'HASH' && exists $self->{$get}) { @@ -329,19 +331,21 @@ Returns: $new_value =back -Simple setter for Classes and hash-based objects which sets and then returns the value -for the field name passed as an argument. When called on a hash-based object it will set the appropriate -hash key value. When called on a class, it will set a class level variable. +Simple setter for Classes and hash-based objects which sets and then returns +the value for the field name passed as an argument. When called on a hash-based +object it will set the appropriate hash key value. When called on a class, it +will set a class level variable. -B: This method will die if you try to set an object variable on a non hash-based object. +B: This method will die if you try to set an object variable on a non +hash-based object. =cut sub set_inherited { my ($self, $set, $val) = @_; - if (blessed $self) { - if (reftype($self) eq 'HASH') { + if (Scalar::Util::blessed($self)) { + if (Scalar::Util::reftype($self) eq 'HASH') { return $self->{$set} = $val; } else { croak('Cannot set inherited value on an object instance that is not hash-based'); @@ -353,6 +357,67 @@ sub set_inherited { }; } +=head2 get_component_class + +=over 4 + +=item Arguments: $field + +Returns: $value + +=back + +Gets the value of the specified component class. + + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + + $self->result_class->method(); + + ## same as + $self->get_component_class('result_class')->method(); + +=cut + +sub get_component_class { + my ($self, $field) = @_; + + return $self->get_inherited($field); +}; + +=head2 set_component_class + +=over 4 + +=item Arguments: $field, $class + +Returns: $new_value + +=back + +Inherited accessor that automatically loads the specified class before setting +it. This method will die if the specified class could not be loaded. + + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + __PACKAGE__->result_class('MyClass'); + + $self->result_class->method(); + +=cut + +sub set_component_class { + my ($self, $field, $value) = @_; + + if ($value) { + if (!Class::Inspector->loaded($value)) { + eval "use $value"; + + croak("Could not load $field '$value': ", $@) if $@; + }; + }; + + return $self->set_inherited($field, $value); +}; + =head2 get_super_paths Returns a list of 'parent' or 'super' class names that the current class inherited from. @@ -360,7 +425,7 @@ Returns a list of 'parent' or 'super' class names that the current class inherit =cut sub get_super_paths { - my $class = blessed $_[0] || $_[0]; + my $class = Scalar::Util::blessed $_[0] || $_[0]; return Class::ISA::super_path($class); }; diff --git a/t/component.t b/t/component.t new file mode 100644 index 0000000..0cdcac2 --- /dev/null +++ b/t/component.t @@ -0,0 +1,25 @@ +use Test::More tests => 7; +use strict; +use warnings; +use lib 't/lib'; +use Class::Inspector; +use AccessorGroups; + +is(AccessorGroups->result_class, undef); + +# croak on set where class can't be loaded +my $dying = AccessorGroups->new; +eval { + $dying->result_class('Junkies'); +}; +ok($@ =~ /Could not load result_class 'Junkies'/); +is($dying->result_class, undef); + +ok(!Class::Inspector->loaded('BaseInheritedGroups')); +AccessorGroups->result_class('BaseInheritedGroups'); +ok(Class::Inspector->loaded('BaseInheritedGroups')); +is(AccessorGroups->result_class, 'BaseInheritedGroups'); + +## unset it +AccessorGroups->result_class(undef); +is(AccessorGroups->result_class, undef); \ No newline at end of file diff --git a/t/lib/AccessorGroups.pm b/t/lib/AccessorGroups.pm index 48e0c7e..3a31fdd 100644 --- a/t/lib/AccessorGroups.pm +++ b/t/lib/AccessorGroups.pm @@ -6,6 +6,7 @@ use base 'Class::Accessor::Grouped'; __PACKAGE__->mk_group_accessors('single', 'singlefield'); __PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/); __PACKAGE__->mk_group_accessors('listref', [qw/lr1name lr1field/], [qw/lr2name lr2field/]); +__PACKAGE__->mk_group_accessors('component_class', 'result_class'); sub new { return bless {}, shift;