1: package AutoLoader;
2: 
3: use strict;
4: use 5.006_001;
5: 
6: our($VERSION, $AUTOLOAD);
7: 
8: my $is_dosish;
9: my $is_epoc;
10: my $is_vms;
11: my $is_macos;
12: 
13: BEGIN {
14:     $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
15:     $is_epoc = $^O eq 'epoc';
16:     $is_vms = $^O eq 'VMS';
17:     $is_macos = $^O eq 'MacOS';
18:     $VERSION = '5.67';
19: }
20: 
21: AUTOLOAD {
22:     my $sub = $AUTOLOAD;
23:     my $filename = AutoLoader::find_filename( $sub );
24: 
25:     my $save = $@;
26:     local $!; # Do not munge the value. 
27:     eval { local $SIG{__DIE__}; require $filename };
28:     if ($@) {
29: 	if (substr($sub,-9) eq '::DESTROY') {
30: 	    no strict 'refs';
31: 	    *$sub = sub {};
32: 	    $@ = undef;
33: 	} elsif ($@ =~ /^Can't locate/) {
34: 	    # The load might just have failed because the filename was too
35: 	    # long for some old SVR3 systems which treat long names as errors.
36: 	    # If we can successfully truncate a long name then it's worth a go.
37: 	    # There is a slight risk that we could pick up the wrong file here
38: 	    # but autosplit should have warned about that when splitting.
39: 	    if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
40: 		eval { local $SIG{__DIE__}; require $filename };
41: 	    }
42: 	}
43: 	if ($@){
44: 	    $@ =~ s/ at .*\n//;
45: 	    my $error = $@;
46: 	    require Carp;
47: 	    Carp::croak($error);
48: 	}
49:     }
50:     $@ = $save;
51:     goto &$sub;
52: }
53: 
54: sub find_filename {
55:     my $sub = shift;
56:     my $filename;
57:     # Braces used to preserve $1 et al.
58:     {
59: 	# Try to find the autoloaded file from the package-qualified
60: 	# name of the sub. e.g., if the sub needed is
61: 	# Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
62: 	# something like '/usr/lib/perl5/Getopt/Long.pm', and the
63: 	# autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
64: 	#
65: 	# However, if @INC is a relative path, this might not work.  If,
66: 	# for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
67: 	# 'lib/Getopt/Long.pm', and we want to require
68: 	# 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
69: 	# In this case, we simple prepend the 'auto/' and let the
70: 	# C<require> take care of the searching for us.
71: 
72: 	my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
73: 	$pkg =~ s#::#/#g;
74: 	if (defined($filename = $INC{"$pkg.pm"})) {
75: 	    if ($is_macos) {
76: 		$pkg =~ tr#/#:#;
77: 		$filename = undef
78: 		  unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
79: 	    } else {
80: 		$filename = undef
81: 		  unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
82: 	    }
83: 
84: 	    # if the file exists, then make sure that it is a
85: 	    # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
86: 	    # or './lib/auto/foo/bar.al'.  This avoids C<require> searching
87: 	    # (and failing) to find the 'lib/auto/foo/bar.al' because it
88: 	    # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
89: 
90: 	    if (defined $filename and -r $filename) {
91: 		unless ($filename =~ m|^/|s) {
92: 		    if ($is_dosish) {
93: 			unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
94: 			    if ($^O ne 'NetWare') {
95: 				$filename = "./$filename";
96: 			    } else {
97: 				$filename = "$filename";
98: 			    }
99: 			}
100: 		    }
101: 		    elsif ($is_epoc) {
102: 			unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
103: 			     $filename = "./$filename";
104: 			}
105: 		    }
106: 		    elsif ($is_vms) {
107: 			# XXX todo by VMSmiths
108: 			$filename = "./$filename";
109: 		    }
110: 		    elsif (!$is_macos) {
111: 			$filename = "./$filename";
112: 		    }
113: 		}
114: 	    }
115: 	    else {
116: 		$filename = undef;
117: 	    }
118: 	}
119: 	unless (defined $filename) {
120: 	    # let C<require> do the searching
121: 	    $filename = "auto/$sub.al";
122: 	    $filename =~ s#::#/#g;
123: 	}
124:     }
125:     return $filename;
126: }
127: 
128: sub import {
129:     my $pkg = shift;
130:     my $callpkg = caller;
131: 
132:     #
133:     # Export symbols, but not by accident of inheritance.
134:     #
135: 
136:     if ($pkg eq 'AutoLoader') {
137: 	if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) {
138: 	    no strict 'refs';
139: 	    *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD;
140: 	}
141:     }
142: 
143:     #
144:     # Try to find the autosplit index file.  Eg., if the call package
145:     # is POSIX, then $INC{POSIX.pm} is something like
146:     # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
147:     # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
148:     #
149:     # However, if @INC is a relative path, this might not work.  If,
150:     # for example, @INC = ('lib'), then
151:     # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
152:     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
153:     #
154: 
155:     (my $calldir = $callpkg) =~ s#::#/#g;
156:     my $path = $INC{$calldir . '.pm'};
157:     if (defined($path)) {
158: 	# Try absolute path name, but only eval it if the
159:         # transformation from module path to autosplit.ix path
160:         # succeeded!
161: 	my $replaced_okay;
162: 	if ($is_macos) {
163: 	    (my $malldir = $calldir) =~ tr#/#:#;
164: 	    $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s);
165: 	} else {
166: 	    $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#);
167: 	}
168: 
169: 	eval { require $path; } if $replaced_okay;
170: 	# If that failed, try relative path with normal @INC searching.
171: 	if (!$replaced_okay or $@) {
172: 	    $path ="auto/$calldir/autosplit.ix";
173: 	    eval { require $path; };
174: 	}
175: 	if ($@) {
176: 	    my $error = $@;
177: 	    require Carp;
178: 	    Carp::carp($error);
179: 	}
180:     } 
181: }
182: 
183: sub unimport {
184:     my $callpkg = caller;
185: 
186:     no strict 'refs';
187: 
188:     for my $exported (qw( AUTOLOAD )) {
189: 	my $symname = $callpkg . '::' . $exported;
190: 	undef *{ $symname } if \&{ $symname } == \&{ $exported };
191: 	*{ $symname } = \&{ $symname };
192:     }
193: }
194: 
195: 1;
196: 
197: __END__
198: 
199: =head1 NAME
200: 
201: AutoLoader - load subroutines only on demand
202: 
203: =head1 SYNOPSIS
204: 
205:     package Foo;
206:     use AutoLoader 'AUTOLOAD';   # import the default AUTOLOAD subroutine
207: 
208:     package Bar;
209:     use AutoLoader;              # don't import AUTOLOAD, define our own
210:     sub AUTOLOAD {
211:         ...
212:         $AutoLoader::AUTOLOAD = "...";
213:         goto &AutoLoader::AUTOLOAD;
214:     }
215: 
216: =head1 DESCRIPTION
217: 
218: The B<AutoLoader> module works with the B<AutoSplit> module and the
219: C<__END__> token to defer the loading of some subroutines until they are
220: used rather than loading them all at once.
221: 
222: To use B<AutoLoader>, the author of a module has to place the
223: definitions of subroutines to be autoloaded after an C<__END__> token.
224: (See L<perldata>.)  The B<AutoSplit> module can then be run manually to
225: extract the definitions into individual files F<auto/funcname.al>.
226: 
227: B<AutoLoader> implements an AUTOLOAD subroutine.  When an undefined
228: subroutine in is called in a client module of B<AutoLoader>,
229: B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a
230: file with a name related to the location of the file from which the
231: client module was read.  As an example, if F<POSIX.pm> is located in
232: F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl
233: subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where
234: the C<.al> file has the same name as the subroutine, sans package.  If
235: such a file exists, AUTOLOAD will read and evaluate it,
236: thus (presumably) defining the needed subroutine.  AUTOLOAD will then
237: C<goto> the newly defined subroutine.
238: 
239: Once this process completes for a given function, it is defined, so
240: future calls to the subroutine will bypass the AUTOLOAD mechanism.
241: 
242: =head2 Subroutine Stubs
243: 
244: In order for object method lookup and/or prototype checking to operate
245: correctly even when methods have not yet been defined it is necessary to
246: "forward declare" each subroutine (as in C<sub NAME;>).  See
247: L<perlsub/"SYNOPSIS">.  Such forward declaration creates "subroutine
248: stubs", which are place holders with no code.
249: 
250: The AutoSplit and B<AutoLoader> modules automate the creation of forward
251: declarations.  The AutoSplit module creates an 'index' file containing
252: forward declarations of all the AutoSplit subroutines.  When the
253: AutoLoader module is 'use'd it loads these declarations into its callers
254: package.
255: 
256: Because of this mechanism it is important that B<AutoLoader> is always
257: C<use>d and not C<require>d.
258: 
259: =head2 Using B<AutoLoader>'s AUTOLOAD Subroutine
260: 
261: In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must>
262: explicitly import it:
263: 
264:     use AutoLoader 'AUTOLOAD';
265: 
266: =head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine
267: 
268: Some modules, mainly extensions, provide their own AUTOLOAD subroutines.
269: They typically need to check for some special cases (such as constants)
270: and then fallback to B<AutoLoader>'s AUTOLOAD for the rest.
271: 
272: Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine.
273: Instead, they should define their own AUTOLOAD subroutines along these
274: lines:
275: 
276:     use AutoLoader;
277:     use Carp;
278: 
279:     sub AUTOLOAD {
280:         my $sub = $AUTOLOAD;
281:         (my $constname = $sub) =~ s/.*:://;
282:         my $val = constant($constname, @_ ? $_[0] : 0);
283:         if ($! != 0) {
284:             if ($! =~ /Invalid/ || $!{EINVAL}) {
285:                 $AutoLoader::AUTOLOAD = $sub;
286:                 goto &AutoLoader::AUTOLOAD;
287:             }
288:             else {
289:                 croak "Your vendor has not defined constant $constname";
290:             }
291:         }
292:         *$sub = sub { $val }; # same as: eval "sub $sub { $val }";
293:         goto &$sub;
294:     }
295: 
296: If any module's own AUTOLOAD subroutine has no need to fallback to the
297: AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit
298: subroutines), then that module should not use B<AutoLoader> at all.
299: 
300: =head2 Package Lexicals
301: 
302: Package lexicals declared with C<my> in the main block of a package
303: using B<AutoLoader> will not be visible to auto-loaded subroutines, due to
304: the fact that the given scope ends at the C<__END__> marker.  A module
305: using such variables as package globals will not work properly under the
306: B<AutoLoader>.
307: 
308: The C<vars> pragma (see L<perlmod/"vars">) may be used in such
309: situations as an alternative to explicitly qualifying all globals with
310: the package namespace.  Variables pre-declared with this pragma will be
311: visible to any autoloaded routines (but will not be invisible outside
312: the package, unfortunately).
313: 
314: =head2 Not Using AutoLoader
315: 
316: You can stop using AutoLoader by simply
317: 
318: 	no AutoLoader;
319: 
320: =head2 B<AutoLoader> vs. B<SelfLoader>
321: 
322: The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the
323: loading of subroutines.
324: 
325: B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>.
326: While this avoids the use of a hierarchy of disk files and the
327: associated open/close for each routine loaded, B<SelfLoader> suffers a
328: startup speed disadvantage in the one-time parsing of the lines after
329: C<__DATA__>, after which routines are cached.  B<SelfLoader> can also
330: handle multiple packages in a file.
331: 
332: B<AutoLoader> only reads code as it is requested, and in many cases
333: should be faster, but requires a mechanism like B<AutoSplit> be used to
334: create the individual files.  L<ExtUtils::MakeMaker> will invoke
335: B<AutoSplit> automatically if B<AutoLoader> is used in a module source
336: file.
337: 
338: =head1 CAVEATS
339: 
340: AutoLoaders prior to Perl 5.002 had a slightly different interface.  Any
341: old modules which use B<AutoLoader> should be changed to the new calling
342: style.  Typically this just means changing a require to a use, adding
343: the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader>
344: from C<@ISA>.
345: 
346: On systems with restrictions on file name length, the file corresponding
347: to a subroutine may have a shorter name that the routine itself.  This
348: can lead to conflicting file names.  The I<AutoSplit> package warns of
349: these potential conflicts when used to split a module.
350: 
351: AutoLoader may fail to find the autosplit files (or even find the wrong
352: ones) in cases where C<@INC> contains relative paths, B<and> the program
353: does C<chdir>.
354: 
355: =head1 SEE ALSO
356: 
357: L<SelfLoader> - an autoloader that doesn't use external files.
358: 
359: =head1 AUTHOR
360: 
361: C<AutoLoader> is maintained by the perl5-porters. Please direct
362: any questions to the canonical mailing list. Anything that
363: is applicable to the CPAN release can be sent to its maintainer,
364: though.
365: 
366: Author and Maintainer: The Perl5-Porters <perl5-porters@perl.org>
367: 
368: Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org>
369: 
370: =head1 COPYRIGHT AND LICENSE
371: 
372: This package has been part of the perl core since the first release
373: of perl5. It has been released separately to CPAN so older installations
374: can benefit from bug fixes.
375: 
376: This package has the same copyright and license as the perl core:
377: 
378:              Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
379:         2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
380:         by Larry Wall and others
381:     
382: 			    All rights reserved.
383:     
384:     This program is free software; you can redistribute it and/or modify
385:     it under the terms of either:
386:     
387: 	a) the GNU General Public License as published by the Free
388: 	Software Foundation; either version 1, or (at your option) any
389: 	later version, or
390:     
391: 	b) the "Artistic License" which comes with this Kit.
392:     
393:     This program is distributed in the hope that it will be useful,
394:     but WITHOUT ANY WARRANTY; without even the implied warranty of
395:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
396:     the GNU General Public License or the Artistic License for more details.
397:     
398:     You should have received a copy of the Artistic License with this
399:     Kit, in the file named "Artistic".  If not, I'll be glad to provide one.
400:     
401:     You should also have received a copy of the GNU General Public License
402:     along with this program in the file named "Copying". If not, write to the 
403:     Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 
404:     02111-1307, USA or visit their web page on the internet at
405:     http://www.gnu.org/copyleft/gpl.html.
406:     
407:     For those of you that choose to use the GNU General Public License,
408:     my interpretation of the GNU General Public License is that no Perl
409:     script falls under the terms of the GPL unless you explicitly put
410:     said script under the terms of the GPL yourself.  Furthermore, any
411:     object code linked with perl does not automatically fall under the
412:     terms of the GPL, provided such object code only adds definitions
413:     of subroutines and variables, and does not otherwise impair the
414:     resulting interpreter from executing any standard Perl script.  I
415:     consider linking in C subroutines in this manner to be the moral
416:     equivalent of defining subroutines in the Perl language itself.  You
417:     may sell such an object file as proprietary provided that you provide
418:     or offer to provide the Perl source, as specified by the GNU General
419:     Public License.  (This is merely an alternate way of specifying input
420:     to the program.)  You may also sell a binary produced by the dumping of
421:     a running Perl script that belongs to you, provided that you provide or
422:     offer to provide the Perl source as specified by the GPL.  (The
423:     fact that a Perl interpreter and your code are in the same binary file
424:     is, in this case, a form of mere aggregation.)  This is my interpretation
425:     of the GPL.  If you still have concerns or difficulties understanding
426:     my intent, feel free to contact me.  Of course, the Artistic License
427:     spells all this out for your protection, so you may prefer to use that.
428: 
429: =cut