Front page | perl.perl5.porters |
Postings from March 2007
AutoLoader inheritance patch
Thread Next
From:
Steffen Mueller
Date:
March 17, 2007 07:53
Subject:
AutoLoader inheritance patch
Message ID:
20070317092627.13837.qmail@lists.develooper.com
Dear p5p,
I have just received a pretty sizable patch to AutoLoader from Marek
Rouchal. I haven't reviewed it in detail yet, but will do so on the
week-end. Since it's not a trivial patch, I'd like to ask permission
before applying it to the CPAN version.
Quoting the RT ticket http://rt.cpan.org/Ticket/Display.html?id=25487 below.
Steffen
---
I created a patch (including tests!) to make AutoLoader work with
class inheritance: so now you can have a base class and a derived
class that both use AutoLoader for some of their methods, and calling
an auto-loadable method in the base class on an object which isa
derived class will no longer result in an error, but the base class'es
method will be loaded and executed. The can() should now work as well
correctly.
Please review the patch, and add any documentation to the POD - I
missed that, sorry :-)
Cheers,
Marek
diff -ruN AutoLoader-5.63/lib/AutoLoader.pm
AutoLoader-5.63p1/lib/AutoLoader.pm
--- AutoLoader-5.63/lib/AutoLoader.pm 2007-01-17 14:18:54.000000000 +0100
+++ AutoLoader-5.63p1/lib/AutoLoader.pm 2007-03-16 16:20:07.000000000 +0100
@@ -15,12 +15,14 @@
$is_epoc = $^O eq 'epoc';
$is_vms = $^O eq 'VMS';
$is_macos = $^O eq 'MacOS';
- $VERSION = '5.63';
+ $VERSION = '5.63_01';
}
AUTOLOAD {
my $sub = $AUTOLOAD;
- my $filename = AutoLoader::find_filename( $sub );
+
+ my $filename;
+ ($sub,$filename) = AutoLoader::find_filename( $sub );
my $save = $@;
local $!; # Do not munge the value.
@@ -36,7 +38,7 @@
# If we can successfully truncate a long name then it's worth a go.
# There is a slight risk that we could pick up the wrong file here
# but autosplit should have warned about that when splitting.
- if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+ if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).'.al'/e){
eval { local $SIG{__DIE__}; require $filename };
}
}
@@ -58,12 +60,20 @@
return $parent if $parent;
my $package = ref( $self ) || $self;
- my $filename = AutoLoader::find_filename( $package . '::' . $method );
+ my ($sub,$filename) = AutoLoader::find_filename( $package . '::' .
$method );
local $@;
return unless eval { require $filename };
no strict 'refs';
- return \&{ $package . '::' . $method };
+ return \&{ $sub };
+}
+
+# get all base packages of the given package
+# Perl does a depth-first search in all from @ISA
+sub get_base_packages {
+ my $pack = shift;
+ no strict 'refs';
+ return map { ($_, AutoLoader::get_base_packages($_)) } @{$pack.'::ISA'}
}
sub find_filename {
@@ -84,16 +94,18 @@
# In this case, we simple prepend the 'auto/' and let the
# C<require> take care of the searching for us.
- my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
- $pkg =~ s#::#/#g;
- if (defined($filename = $INC{"$pkg.pm"})) {
+ my ($mpkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
+ my @pkgs = ($mpkg, AutoLoader::get_base_packages($mpkg));
+ while(my $pkg = shift(@pkgs)) {
+ (my $pfname = $pkg) =~ s#::#/#g;
+ if (defined($filename = $INC{$pfname.'.pm'})) {
if ($is_macos) {
- $pkg =~ tr#/#:#;
+ $pfname =~ tr#/#:#;
$filename = undef
- unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
+ unless $filename =~ s#^(.*)\Q$pfname\E\.pm\z#$1auto:$pfname:$func.al#s;
} else {
$filename = undef
- unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
+ unless $filename =~ s#^(.*)\Q$pfname\E\.pm\z#$1auto/$pfname/$func.al#s;
}
# if the file exists, then make sure that it is a
@@ -101,13 +113,12 @@
# or './lib/auto/foo/bar.al'. This avoids C<require> searching
# (and failing) to find the 'lib/auto/foo/bar.al' because it
# looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
-
if (defined $filename and -r $filename) {
unless ($filename =~ m|^/|s) {
if ($is_dosish) {
unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
if ($^O ne 'NetWare') {
- $filename = "./$filename";
+ $filename = './'.$filename;
} else {
$filename = "$filename";
}
@@ -115,29 +126,32 @@
}
elsif ($is_epoc) {
unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
- $filename = "./$filename";
+ $filename = './'.$filename;
}
}
elsif ($is_vms) {
# XXX todo by VMSmiths
- $filename = "./$filename";
+ $filename = './'.$filename;
}
elsif (!$is_macos) {
- $filename = "./$filename";
+ $filename = './'.$filename;
}
}
+ $sub = $pkg.'::'.$func;
}
else {
$filename = undef;
}
- }
+ }
+ last if defined $filename;
+ } # end while packages
unless (defined $filename) {
# let C<require> do the searching
$filename = "auto/$sub.al";
$filename =~ s#::#/#g;
}
}
- return $filename;
+ return ($sub,$filename);
}
sub import {
diff -ruN AutoLoader-5.63/MANIFEST AutoLoader-5.63p1/MANIFEST
--- AutoLoader-5.63/MANIFEST 2007-01-17 14:19:47.000000000 +0100
+++ AutoLoader-5.63p1/MANIFEST 2007-03-16 15:44:49.000000000 +0100
@@ -7,4 +7,11 @@
README
t/00pod.t
t/AutoLoader.t
+t/inherit.t
+t/al_lib/AL_Base.pm
+t/al_lib/AL_Derived.pm
+t/al_lib/auto/AL_Base/A_dynamic.al
+t/al_lib/auto/AL_Base/autosplit.ix
+t/al_lib/auto/AL_Derived/autosplit.ix
+t/al_lib/auto/AL_Derived/B_dynamic.al
META.yml Module meta-data (added by MakeMaker)
diff -ruN AutoLoader-5.63/t/al_lib/AL_Base.pm
AutoLoader-5.63p1/t/al_lib/AL_Base.pm
--- AutoLoader-5.63/t/al_lib/AL_Base.pm 1970-01-01 01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/al_lib/AL_Base.pm 2007-03-16 14:49:39.000000000
+0100
@@ -0,0 +1,18 @@
+#!perl
+
+package AL_Base;
+
+use AutoLoader qw(AUTOLOAD);
+
+sub new {
+ my $class = shift;
+ return bless({}, $class);
+}
+
+sub A_static {
+ my __PACKAGE__ $this = shift;
+ return "from A_static";
+}
+
+1;
+
diff -ruN AutoLoader-5.63/t/al_lib/AL_Derived.pm
AutoLoader-5.63p1/t/al_lib/AL_Derived.pm
--- AutoLoader-5.63/t/al_lib/AL_Derived.pm 1970-01-01 01:00:00.000000000
+0100
+++ AutoLoader-5.63p1/t/al_lib/AL_Derived.pm 2007-03-16
14:49:38.000000000 +0100
@@ -0,0 +1,14 @@
+#!perl
+
+package AL_Derived;
+
+use AutoLoader qw(AUTOLOAD);
+use base qw(AL_Base);
+
+sub B_static {
+ my __PACKAGE__ $this = shift;
+ return "from B_static, " . $this->A_static;
+}
+
+1;
+
diff -ruN AutoLoader-5.63/t/al_lib/auto/AL_Base/A_dynamic.al
AutoLoader-5.63p1/t/al_lib/auto/AL_Base/A_dynamic.al
--- AutoLoader-5.63/t/al_lib/auto/AL_Base/A_dynamic.al 1970-01-01
01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/al_lib/auto/AL_Base/A_dynamic.al 2007-03-16
14:49:36.000000000 +0100
@@ -0,0 +1,10 @@
+#!perl
+
+package AL_Base;
+
+sub A_dynamic {
+ return "from A_dynamic";
+}
+
+1;
+
diff -ruN AutoLoader-5.63/t/al_lib/auto/AL_Base/autosplit.ix
AutoLoader-5.63p1/t/al_lib/auto/AL_Base/autosplit.ix
--- AutoLoader-5.63/t/al_lib/auto/AL_Base/autosplit.ix 1970-01-01
01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/al_lib/auto/AL_Base/autosplit.ix 2007-03-16
14:43:11.000000000 +0100
@@ -0,0 +1,2 @@
+sub A_dynamic;
+1;
diff -ruN AutoLoader-5.63/t/al_lib/auto/AL_Derived/autosplit.ix
AutoLoader-5.63p1/t/al_lib/auto/AL_Derived/autosplit.ix
--- AutoLoader-5.63/t/al_lib/auto/AL_Derived/autosplit.ix 1970-01-01
01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/al_lib/auto/AL_Derived/autosplit.ix 2007-03-16
14:43:31.000000000 +0100
@@ -0,0 +1,2 @@
+sub B_dynamic;
+1;
diff -ruN AutoLoader-5.63/t/al_lib/auto/AL_Derived/B_dynamic.al
AutoLoader-5.63p1/t/al_lib/auto/AL_Derived/B_dynamic.al
--- AutoLoader-5.63/t/al_lib/auto/AL_Derived/B_dynamic.al 1970-01-01
01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/al_lib/auto/AL_Derived/B_dynamic.al 2007-03-16
14:49:38.000000000 +0100
@@ -0,0 +1,11 @@
+#!perl
+
+package AL_Derived;
+
+sub B_dynamic {
+ my __PACKAGE__ $this = shift;
+ return "from B_dynamic, " . $this->A_dynamic;
+}
+
+1;
+
diff -ruN AutoLoader-5.63/t/inherit.t AutoLoader-5.63p1/t/inherit.t
--- AutoLoader-5.63/t/inherit.t 1970-01-01 01:00:00.000000000 +0100
+++ AutoLoader-5.63p1/t/inherit.t 2007-03-16 16:24:04.000000000 +0100
@@ -0,0 +1,50 @@
+#!./perl -w
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = qw(../lib al_lib);
+ } else {
+ unshift(@INC, qw(t/al_lib));
+ }
+}
+
+use Test::More tests => 10;
+
+# ok 1
+require_ok('AL_Derived');
+
+my $derived = AL_Derived->new;
+
+# ok 2
+ok(defined $derived, "Created object instance");
+
+# ok 3
+isa_ok($derived, 'AL_Derived');
+
+# ok 4
+isa_ok($derived, 'AL_Base');
+
+# ok 5
+is($derived->A_static, "from A_static", "static method found in base
class");
+
+my $a_dyn = $derived->can('A_dynamic'); # this loads the method
+
+# ok 6
+is($derived->A_dynamic, "from A_dynamic", "dynamic method found in base
class");
+
+# ok 7
+is($a_dyn, \&AL_Base::A_dynamic, "\$obj->can works as expected");
+
+# ok 8
+is($derived->B_static, "from B_static, from A_static", "static method
found in derived class");
+
+# ok 9
+is($derived->B_dynamic, "from B_dynamic, from A_dynamic", "dynamic
method found in derived class");
+
+# ok 10
+eval { $derived->nonexist };
+like($@, qr/Can't locate.*in \@INC/, "undefined method throws exception");
+
+exit 0;
+
Thread Next
-
AutoLoader inheritance patch
by Steffen Mueller