Class-WhiteHole-0.04/0040755000076500000240000000000007707645714013751 5ustar schwernstaffClass-WhiteHole-0.04/Changes0100644000076500000240000000115407665226375015243 0ustar schwernstaffRevision history for Perl extension Class::WhiteHole 0.04 Wed Feb 7 11:42:48 GMT 2001 - Test #4 fails on Win32, but just because a filename was different there than under Unix. I think I've corrected for it. NOT A REAL BUG! 0.03 Sun Jul 9 16:48:20 EDT 2000 - Error message still not quite right. Now reporting the right line number and file. 0.02 Sun Jul 9 09:03:26 GMT 2000 *UNRELEASED* - Error message slightly off. - Forgot to let DESTORY through. - Wasn't getting the class name properly. 0.01 Fri Jul 7 08:13:19 GMT 2000 - First working version. Class-WhiteHole-0.04/lib/0040755000076500000240000000000007707645714014517 5ustar schwernstaffClass-WhiteHole-0.04/lib/Class/0040755000076500000240000000000007707645714015564 5ustar schwernstaffClass-WhiteHole-0.04/lib/Class/WhiteHole.pm0100644000076500000240000000367507665226375020023 0ustar schwernstaff# $Id: WhiteHole.pm,v 1.4 2001/02/07 11:42:37 schwern Exp $ package Class::WhiteHole; require 5; use strict; use vars qw(@ISA $VERSION $ErrorMsg); $VERSION = '0.04'; @ISA = (); # From 5.6.0's perldiag. $ErrorMsg = qq{Can\'t locate object method "%s" via package "%s" }. qq{at %s line %d.\n}; =pod =head1 NAME Class::WhiteHole - base class to treat unhandled method calls as errors =head1 SYNOPSIS package Bar; # DBI inherits from DynaLoader which inherits from AutoLoader # Bar wants to avoid this accidental inheritance of AutoLoader. use base qw(Class::WhiteHole DBI); =head1 DESCRIPTION Its possible to accidentally inherit an AUTOLOAD method. Often this will happen if a class somewhere in the chain uses AutoLoader or defines one of their own. This can lead to confusing error messages when method lookups fail. Sometimes you want to avoid this accidental inheritance. In that case, inherit from Class::WhiteHole. All unhandled methods will produce normal Perl error messages. =head1 BUGS & CAVEATS Be sure to have Class::WhiteHole before the class from which you're inheriting AUTOLOAD in the ISA. Usually you'll want Class::WhiteHole to come first. If your class inherits autoloaded routines this class may cause them to stop working. Choose wisely before using. White holes are only a hypothesis and may not really exist. =head1 COPYRIGHT Copyright 2000 Michael G Schwern all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Michael G Schwern =head1 SEE ALSO L =cut sub AUTOLOAD { my($proto) = shift; my($class) = ref $proto || $proto; my($meth) = $Class::WhiteHole::AUTOLOAD =~ m/::([^:]+)$/; return if $meth eq 'DESTROY'; my($callpack, $callfile, $callline) = caller; die sprintf $ErrorMsg, $meth, $class, $callfile, $callline; } 1; Class-WhiteHole-0.04/Makefile.PL0100644000076500000240000000233507665226375015724 0ustar schwernstaff# A template for Makefile.PL used by Arena Networks. # - Set the $PACKAGE variable to the name of your module. # - Set $LAST_API_CHANGE to reflect the last version you changed the API # of your module. # - Fill in your dependencies in PREREQ_PM # Alternatively, you can say the hell with this and use h2xs. use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. $PACKAGE = 'Class::WhiteHole'; ($PACKAGE_FILE) = $PACKAGE =~ /(?:\::)?([^:]+)$/; $LAST_API_CHANGE = 0; eval "require $PACKAGE"; unless ($@) { # Make sure we did find the module. print <<"CHANGE_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_API_CHANGE; NOTE: There have been API changes between this version and any older than version $LAST_API_CHANGE! Please read the Changes file if you are upgrading from a version older than $LAST_API_CHANGE. CHANGE_WARN } WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/Class/$PACKAGE_FILE.pm", # finds $VERSION PREREQ_PM => { }, 'dist' => { COMPRESS => 'gzip -9', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', }, ); Class-WhiteHole-0.04/MANIFEST0100644000076500000240000000022007707645706015072 0ustar schwernstaffMANIFEST Makefile.PL t/WhiteHole.t lib/Class/WhiteHole.pm Changes META.yml Module meta-data (added by MakeMaker) Class-WhiteHole-0.04/META.yml0100644000076500000240000000041007707645714015212 0ustar schwernstaff#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Class-WhiteHole version: 0.04 version_from: lib/Class/WhiteHole.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.10_08 Class-WhiteHole-0.04/t/0040755000076500000240000000000007707645714014214 5ustar schwernstaffClass-WhiteHole-0.04/t/WhiteHole.t0100644000076500000240000000331407665226375016270 0ustar schwernstaff# 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.) use strict; use vars qw($Total_tests); my $loaded; my $test_num = 1; BEGIN { $| = 1; $^W = 1; } END {print "not ok $test_num\n" unless $loaded;} print "1..$Total_tests\n"; use Class::WhiteHole; $loaded = 1; ok(1, 'compile'); ######################### End of black magic. # Utility testing functions. sub ok { my($test, $name) = @_; print "not " unless $test; print "ok $test_num"; print " - $name" if defined $name; print "\n"; $test_num++; } sub eqarray { my($a1, $a2) = @_; return 0 unless @$a1 == @$a2; my $ok = 1; for (0..$#{$a1}) { unless($a1->[$_] eq $a2->[$_]) { $ok = 0; last; } } return $ok; } # Change this to your # of ok() calls + 1 BEGIN { $Total_tests = 6 } package Moo; sub AUTOLOAD { return "AUTOLOADER!" } package Test; sub foo { return 456 } @Test::ISA = qw(Class::WhiteHole Moo); ::ok( Test->foo == 456, "static methods work" ); ::ok( !eval { Test->bar; 1; }, "autoloader blocked" ); # must be line 57 # There's a precedence problem. Can't pass this all at once. my $ok = $@ eq qq{Can\'t locate object method "bar" via package "Test" at $0 line 57.\n}; ::ok( $ok, "Dying message preserved"); ::ok( Test->can('foo'), "UNIVERSAL not effected" ); eval { my $test_obj = bless {}, 'Test'; }; ::ok( !$@, "DESTROY() not effected" );