| Subject: | [PATCH] Enhancement: Allow overridden class data to return to inheriting superclass data |
Hi,
I have a small enhancement for your Class::Data::Inheritable perl module
which allows overridden class data to be reset so that it sees an
inherited value once again, just like it would have done before
overriding it.
It works by passing in the undefined value as the new value of the
overridden data. I realize that this could cause trouble for anyone
actually wanting to set the undefined value as the overridden value, so
it would require at least a prominent warning about changed behaviour in
the new version, or maybe it should be optional behaviour that only
kicks in when some special 'import' symbol is passed in?
I've attached a patch against version 0.08. Only the 'Changes' file has
not been updated. (The patch also corrects a couple of uses of the word
"effect" which should be "affect".)
Regards,
Steve
| Subject: | C-D-I.patch |
diff -ruN Class-Data-Inheritable-0.08/META.yml Class-Data-Inheritable-0.09/META.yml
--- Class-Data-Inheritable-0.08/META.yml 2008-01-25 11:51:08.000000000 +0000
+++ Class-Data-Inheritable-0.09/META.yml 2009-11-04 11:46:28.475438900 +0000
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Class-Data-Inheritable
-version: 0.08
+version: 0.09
abstract: Inheritable, overridable class data
license: perl
author: ~
diff -ruN Class-Data-Inheritable-0.08/README Class-Data-Inheritable-0.09/README
--- Class-Data-Inheritable-0.08/README 2008-01-25 11:37:02.000000000 +0000
+++ Class-Data-Inheritable-0.09/README 2009-11-04 11:45:48.897060600 +0000
@@ -57,11 +57,17 @@
Raygun->Suitcase('Orange');
Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu no
- longer effect Raygun.
+ longer affect Raygun.
# Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
Pere::Ubu->Suitcase('Samsonite');
+ Raygun can clear its override by setting its value to undef, and it will
+ then return to inheriting from Pere::Ubu once more.
+
+ # Raygun now shares Pere::Ubu's suitcase again
+ Raygun->Suitcase(undef);
+
Methods
mk_classdata
Class->mk_classdata($data_accessor_name);
diff -ruN Class-Data-Inheritable-0.08/lib/Class/Data/Inheritable.pm Class-Data-Inheritable-0.09/lib/Class/Data/Inheritable.pm
--- Class-Data-Inheritable-0.08/lib/Class/Data/Inheritable.pm 2008-01-25 11:51:00.000000000 +0000
+++ Class-Data-Inheritable-0.09/lib/Class/Data/Inheritable.pm 2009-11-04 11:44:45.693531100 +0000
@@ -2,7 +2,9 @@
use strict qw(vars subs);
use vars qw($VERSION);
-$VERSION = '0.08';
+$VERSION = '0.09';
+
+use Class::ISA;
sub mk_classdata {
my ($declaredclass, $attribute, $data) = @_;
@@ -19,7 +21,13 @@
if @_>1 && $wantclass ne $declaredclass;
$data = $_[1] if @_>1;
- return $data;
+ return $data if defined $data;
+ foreach my $class (Class::ISA::super_path($wantclass)) {
+ if (my $accessor = $class->can($attribute)) {
+ return $class->$accessor() if defined $class->$accessor();
+ }
+ }
+ return; # attribute not found
};
my $alias = "_${attribute}_accessor";
@@ -93,11 +101,17 @@
Raygun->Suitcase('Orange');
Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
-no longer effect Raygun.
+no longer affect Raygun.
# Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
Pere::Ubu->Suitcase('Samsonite');
+Raygun can clear its override by setting its value to undef, and it will
+then return to inheriting from Pere::Ubu once more.
+
+ # Raygun now shares Pere::Ubu's suitcase again
+ Raygun->Suitcase(undef);
+
=head1 Methods
=head2 mk_classdata
diff -ruN Class-Data-Inheritable-0.08/t/Inheritable.t Class-Data-Inheritable-0.09/t/Inheritable.t
--- Class-Data-Inheritable-0.08/t/Inheritable.t 2005-09-24 14:52:16.000000000 +0100
+++ Class-Data-Inheritable-0.09/t/Inheritable.t 2009-11-04 11:37:18.251420100 +0000
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 15;
+use Test::More tests => 16;
package Ray;
use base qw(Class::Data::Inheritable);
@@ -21,7 +21,7 @@
qw/mk_classdata Ubu _Ubu_accessor DataFile _DataFile_accessor/;
}
-# Test that superclasses effect children.
+# Test that superclasses affect children.
is +Gun->Ubu, 'Pere', 'Ubu in Gun';
is +Suitcase->Ubu, 'Pere', "Inherited into children";
is +Ray->Ubu, undef, "But not set in parent";
@@ -37,6 +37,9 @@
is +Gun->DataFile, '/tmp/stuff', "filters down to unchanged children";
is +Suitcase->DataFile, '/etc/otherstuff/data', "but not to changed";
+# Now reset in changed child
+Suitcase->DataFile(undef);
+is +Suitcase->DataFile, '/tmp/stuff', "Data inherited when cleared";
my $obj = bless {}, 'Gun';
eval { $obj->mk_classdata('Ubu') };