Class-AutoloadCAN-0.03/0000755000175000017500000000000010226176457016005 5ustar knoppixknoppix00000000000000Class-AutoloadCAN-0.03/lib/0000755000175000017500000000000010226176457016553 5ustar knoppixknoppix00000000000000Class-AutoloadCAN-0.03/lib/Class/0000755000175000017500000000000010226176457017620 5ustar knoppixknoppix00000000000000Class-AutoloadCAN-0.03/lib/Class/AutoloadCAN.pm0000444000175000017500000001743510226176402022246 0ustar knoppixknoppix00000000000000package Class::AutoloadCAN; $VERSION = 0.03; use strict; no strict 'refs'; use vars qw($AUTOLOAD); my %base_install; sub import { shift; # Get rid of class @_ = scalar caller unless @_; for (@_) { # For giggles and grins, archaic compatibility. This should work with # Perl 5.003. (Untested.) my $class = $_; $base_install{$class}++; *{"$class\::AUTOLOAD"} = sub { my $method = _can($AUTOLOAD, @_); if ($method) { return &$method; } my ($package, $file, $line) = caller; my $where = qq(package "$class" at $file line $line.); if ($AUTOLOAD =~ /(.*)::([^:]+)/) { my $package = $1; my $method = $2; die qq(Can't locate object method "$method" via package "$package" at $where\n); } else { die qq(AUTOLOAD saw no \$AUTOLOAD after $where\n); } }; } } # The arguments have been rearranged here. That is for the promise I made # that you can do anything with this strategy that you can with AUTOLOAD. # I even support the case where you've AUTOLOADed calling an autoloaded # function directly without arguments. sub _can { my ($method, @args) = @_; my $self = $args[0]; my %checked; # Need to reset these on the off chance that people are dynamically # changing @ISA. Right behaviour over speed... reset_installed(); my $base_class = ref($self) || $self; $method =~ s/'/::/g; if ($method =~ /^(.*)::([^:]+)/) { $base_class = $1; $method = $2; } my %seen; my @classes = ($base_class, 'UNIVERSAL'); while (@classes) { my $class = shift @classes; next if $seen{$class}++; if (my $CAN = *{"$class\::CAN"}{CODE}) { # Need to figure out whether I pay attention to CAN. # I probably do - I'm only called if you inherit from # someone who does, but I might have gone past where I # was installed to, in which case I can prune the # inheritance tree slightly. next unless installed($class); my $sub = $CAN->($base_class, $method, @args); return $sub if $sub; } unshift @classes, @{"$class\::ISA"}; } }; local $^W; my $original_can = \&UNIVERSAL::can; *UNIVERSAL::can = sub { my $sub = $original_can->(@_[0,1]); return $sub if $sub; _can(@_[1,0,2..$#_]); }; # These hashes track which classes I'm paying attention to CAN in. my %installed; my %not_installed; my %testing_install; sub reset_installed { %installed = %base_install; %not_installed = %testing_install = (); } # This function takes a class and sets %installed or %not_installed # appropriately for that class; sub installed { my $base_class = shift; return 1 if $installed{$base_class}; return if $not_installed{$base_class}; return if $testing_install{$base_class}++; # Avoid infinite recursion. my @classes = (@{"$base_class\::ISA"}, 'UNIVERSAL'); foreach (@classes) { # For giggles and grins, archaic compatibility. This should work with # Perl 5.003. (Untested.) my $class = $_; return $installed{$base_class} = 1 if installed($class); } $not_installed{$base_class} = 1; return; } 1; __END__ =head1 NAME Class::AutoloadCAN - Make AUTOLOAD, can and inheritance cooperate. =head1 SYNOPSIS package Foo; use Class::AutoloadCAN; sub CAN { my ($starting_class, $method, $self, @arguments) = @_; return sub { my $self = shift; print join ", ", $method, @_; print "\n"; }; } # And this prints the famous greeting. Foo->hello("world"); =head1 DESCRIPTION This module solves a fundamental conflict between AUTOLOAD, can and inheritance. The problem is that while you can implement anything in AUTOLOAD, UNIVERSAL::can is not aware that it is there. Attempting to modify UNIVERSAL::can to document those methods is very hard. And if a parent class uses AUTOLOAD then subclasses have to do a lot of work to make their AUTOLOADs cooperate with the parent one. It is harder still if 2 parent classes in a multiple inheritance tree wish to cooperate with each other. Few try to do this, which may be good since those who try usually get it wrong. See http://www.perlmonks.org/?node_id=342804 for a fuller discussion. With this module instead of writing AUTOLOADs, you write CANs. Based on what they return, Class::AutoloadCAN will decide whether you handle the call or it needs to search higher up the inheritance chain. Here are the methods and functions that matter for the operation of this module. =over 4 =item C An AUTOLOAD will be installed in every package that uses this module. You can choose to have it installed in other packages. If you write your own AUTOLOADs, you can easily break this module. So don't do that. Write CANs instead. =item C UNIVERSAL::can will be modified to be aware of the functions provided dynamically through this module. You are free to override can in any subclass and this module will not interfere. I have no idea why you would want to, though. =item =item C If there is a method named CAN in a class that inherits from one that Universal::AutoloadCAN was installed to, it may be called in deciding how a method is implemented. It will be passed the class that the method search started in, the method name, the object called, and the arguments to the function. It is expected to do nothing but return a subroutine reference if it implements that method on that object, or undef otherwise. If that subroutine is actually called, it will be passed all of the usual arguments that a method call gets, and the AUTOLOAD that found it will erase itself from the callstack. =item C If the import method for Class::AutoloadCAN is called with no arguments it installs an AUTOLOAD in the calling class. If it is called with arguments, it installs an AUTOLOAD in those classes as well. Use with caution: this is a convenience feature that is not expected to be used very often. =back =head1 SUGGESTION Many people use AUTOLOAD to implement large numbers of fixed and straightforward methods. Such as accessors. If you are doing this, then I suggest implementing them by typeglobbing closures instead of by using AUTOLOAD or this module. Here is a simple example: package Parent; use strict; sub make_accessors { my ($class, @attributes) = @_; foreach my $attribute (@attributes) { no strict 'refs'; *{"$class\::$attribute"} = sub { my $self = shift; if (@_) { $self->{$attribute} = shift; } return $self->{$attribute}; }; } } package Child; our @ISA = 'Parent'; __PACKAGE__->make_accessors(qw(this that the other)); This approach is simpler, often faster, and avoids some of the problems that AUTOLOAD has, like mistaking function calls as method calls. =head1 BUGS AND LIMITATIONS There are many other issues with AUTOLOAD that this module does not address. Primary among them is the fact that if you call a function that does not exist in a package that inherits from one with an AUTOLOAD, Perl will do a method search for that AUTOLOAD. This is why this module does not install AUTOLOAD in UNIVERSAL by default, and it is strongly suggested that you not do so either. Also many people like to lazily install AUTOLOADed methods in the local package so that they will be found more quickly in the future. This module won't do that for you, but you can easily do that from within CAN. The reason that this module doesn't do that is that some useful CANs may decide whether to support a method on an object by object basis. =head1 ACKNOWLEDGEMENTS My thanks to various people on Perlmonks for conversations that clarified what problems AUTOLOAD raises, and convinced me that it would be good to have a solution to them. =head1 AUTHOR AND COPYRIGHT Ben Tilly (btilly@gmail.com). Copyright 2005. This may be copied, modified and distributed on the same terms as Perl. Class-AutoloadCAN-0.03/MANIFEST0000444000175000017500000000012710225734245017126 0ustar knoppixknoppix00000000000000Changes lib/Class/AutoloadCAN.pm MANIFEST test.pl README Build.PL Makefile.PL META.yml Class-AutoloadCAN-0.03/META.yml0000444000175000017500000000042710226176457017257 0ustar knoppixknoppix00000000000000--- #YAML:1.0 name: Class-AutoloadCAN version: 0.03 license: perl distribution_type: module requires: {} recommends: {} build_requires: {} conflicts: {} provides: Class::AutoloadCAN: file: lib/Class/AutoloadCAN.pm version: 0.03 generated_by: Module::Build version 0.20 Class-AutoloadCAN-0.03/test.pl0000444000175000017500000000634310226176002017307 0ustar knoppixknoppix00000000000000#! /usr/bin/perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..20\n"; } END {print "not ok 1\n" unless $loaded;} use Class::AutoloadCAN; use Carp; $loaded = 1; print "ok 1\n"; my $tests_done = 1; # The following classes are used in later tests. They are here so that # the inheritance is set up before those tests. { package NoAutoload; sub implemented { "foo" }; sub CAN { sub {"bar"}; } package Base1; Class::AutoloadCAN->import; # This CAN is always paid attention to. sub CAN { my ($base_class, $method, $self, @args) = @_; return sub {"Base1"} if $method =~ /base1/; } package Base2; # This CAN is only paid attention to after we call import. sub CAN { my ($base_class, $method, $self, @args) = @_; return sub {"Base2"} if $method =~ /base2/; } package Child; @ISA = qw(Base1 Base2); # This CAN is paid attention to through inheritance. sub CAN { my ($base_class, $method, $self, @args) = @_; return sub {"Child"} if $method =~ /child/; } package GrandChild; @ISA = 'Child'; sub can {"overridden"} package GreatGrandChild; use Class::AutoloadCAN; @ISA = 'GrandChild'; } true(NoAutoload->can("implemented"), "Raw subs work"); true(NoAutoload->implemented eq "foo", "Raw subs are called normally"); true(!NoAutoload->can("not_implemented"), "CAN ignored if not AUTOLOADED"); eval {NoAutoload->not_implemented}; true($@ =~ /object method/, "Missing methods are missing if not AUTOLOADED"); eval {NoAutoload::not_implemented()}; true($@ =~ /subroutine/, "Missing subroutines are missing if not AUTOLOADED"); true(!NoAutoload->can("Child::implemented"), "Reset method search"); true(Child->can("child_method"), "CAN used in class"); true(Child->child_method eq "Child", "Child gets its own methods"); true(Child->can("base1_method"), "Inherited CAN seen"); true(Child->base1_method eq "Base1", "Child gets inherited CAN methods"); true(!Child->can("base2_method"), "CAN from ignored class, ignored"); eval "Child->base2_method"; true(($@ and $@ =~ /object method/), "Ignored class doesn't provide methods"); true(($@ and $@ =~ /"Child"/), "The error message includes the package"); true(($@ and $@ !~ /forgot to load/), "No load message on loaded package"); true(($@ =~ /eval/) ? 1 : 0, "The error comes from the right caller"); Class::AutoloadCAN->import("Base2"); true(Child->can("base2_method"), "Can unignore class"); true(Child->base2_method eq "Base2", "Unignored class provides methods"); true(GreatGrandChild->child_method eq "Child", "Can inherit through overridden can"); true(GreatGrandChild->can("child_method") eq "overridden", "But can is overridden"); sub true { my ($value, $test) = @_; confess("Wrong number of arguments") unless 2 == @_; $tests_done++; if ($value) { print "ok $tests_done\n"; #print STDERR "\n\n$tests_done: $test succeeded\n"; } else { print "not ok $tests_done\n"; print STDERR "\n\n$tests_done: $test failed\n"; } } Class-AutoloadCAN-0.03/Changes0000444000175000017500000000345210226176444017276 0ustar knoppixknoppix00000000000000Revision history for Perl extension UNIVERSAL::AUTOLOAD_CAN. 0.01 Sat Apr 9 4:30 PDT 2005 - Wrote module and released on CPAN. 0.02 Sat Apr 9 17:40 PDT 2005 - Fixed a bug where errors were reported on the wrong line. - Added comment in code explaining a surprising argument order. 0.03 Sat Apr 9 23:20 PDT 2005 - Added strict. Originally this was left out because of how many symbolic references there are, but adding it caught one accidental global. (Which could have led to an object having a longer life than expected.) - Removed an internal debugging hook (installed/_installed) that I used in development. - Thanks to a suggestion from Joshua Jore (diotalevi on perlmonks) I noticed that Module::Build has "traditional" that I can use instead of "passthrough", thereby removing the dependency that users have Module::Build installed. - Cleaned up the AUTOLOAD stuff. I find it bizarre that if I assign a typeglob to your classes AUTOLOAD, $AUTOLOAD is set in my class when that is called. Convenient, but bizarre. - I only need to call the original UNIVERSAL::can on a call to can, not to AUTOLOAD. (If you reach AUTOLOAD, you know that it will fail to find anything with the original UNIVERSAL::can.) - Removed use of no warnings. Together with the "traditional" change this should make my module work on Perl 5.005_04. - While I'm at it, use a backwards compatibility trick. This module now has a chance of working all of the way back to 5.003. - I had not duplicated all of Perl's message on missing methods. Improved compatibility and added tests. - Changed the order of testing for CAN and checking installed. The new order is likely to be slightly more efficient. Not that anything else about this module is efficient... Class-AutoloadCAN-0.03/Makefile.PL0000444000175000017500000000037010226176457017755 0ustar knoppixknoppix00000000000000# Generated by Module::Build::Compat->create_makefile_pl use ExtUtils::MakeMaker; WriteMakefile ( NAME => 'Class::AutoloadCAN', VERSION => '0.03', PL_FILES => {}, INSTALLDIRS => 'site', PREREQ_PM => { }, ); Class-AutoloadCAN-0.03/Build.PL0000444000175000017500000000024210226166233017264 0ustar knoppixknoppix00000000000000use Module::Build; Module::Build->new( module_name => "Class::AutoloadCAN", license => 'perl', create_makefile_pl => 'traditional', )->create_build_script; Class-AutoloadCAN-0.03/README0000444000175000017500000000131110225711702016642 0ustar knoppixknoppix00000000000000By default when you write an AUTOLOAD, the functions that are available from it are not visible to UNIVERSAL::can. Worse yet, if you try to use AUTOLOAD in a subclass, you hide the AUTOLOAD in a superclass (or in classes farther down the tree in multiple inheritance) so AUTOLOAD and inheritance do not play well together. See http://www.perlmonks.org/?node_id=342804 for a full explanation of the problems. This module attempts to solve that. Import this module somewhere in the class hierarchy that you wish to have your AUTOLOAD, and write a CAN which takes arguments and returns a function that will do that. This module will then provide an AUTOLOAD and UNIVERSAL::can that cooperate and work properly.