1# $Id: WhiteHole.pm,v 1.4 2001/02/07 11:42:37 schwern Exp $ 2 3package Class::WhiteHole; 4 5require 5; 6use strict; 7use vars qw(@ISA $VERSION $ErrorMsg); 8 9$VERSION = '0.04'; 10@ISA = (); 11 12# From 5.6.0's perldiag. 13$ErrorMsg = qq{Can\'t locate object method "%s" via package "%s" }. 14 qq{at %s line %d.\n}; 15 16 17=pod 18 19=head1 NAME 20 21Class::WhiteHole - base class to treat unhandled method calls as errors 22 23 24=head1 SYNOPSIS 25 26 package Bar; 27 28 # DBI inherits from DynaLoader which inherits from AutoLoader 29 # Bar wants to avoid this accidental inheritance of AutoLoader. 30 use base qw(Class::WhiteHole DBI); 31 32 33=head1 DESCRIPTION 34 35Its possible to accidentally inherit an AUTOLOAD method. Often this 36will happen if a class somewhere in the chain uses AutoLoader or 37defines one of their own. This can lead to confusing error messages 38when method lookups fail. 39 40Sometimes you want to avoid this accidental inheritance. In that 41case, inherit from Class::WhiteHole. All unhandled methods will 42produce normal Perl error messages. 43 44 45=head1 BUGS & CAVEATS 46 47Be sure to have Class::WhiteHole before the class from which you're 48inheriting AUTOLOAD in the ISA. Usually you'll want Class::WhiteHole 49to come first. 50 51If your class inherits autoloaded routines this class may cause them 52to stop working. Choose wisely before using. 53 54White holes are only a hypothesis and may not really exist. 55 56 57=head1 COPYRIGHT 58 59Copyright 2000 Michael G Schwern <schwern@pobox.com> all rights 60reserved. This program is free software; you can redistribute it 61and/or modify it under the same terms as Perl itself. 62 63 64=head1 AUTHOR 65 66Michael G Schwern <schwern@pobox.com> 67 68=head1 SEE ALSO 69 70L<Class::BlackHole> 71 72=cut 73 74sub AUTOLOAD { 75 my($proto) = shift; 76 my($class) = ref $proto || $proto; 77 78 my($meth) = $Class::WhiteHole::AUTOLOAD =~ m/::([^:]+)$/; 79 80 return if $meth eq 'DESTROY'; 81 82 my($callpack, $callfile, $callline) = caller; 83 84 die sprintf $ErrorMsg, $meth, $class, $callfile, $callline; 85} 86 87 881; 89 90