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