autoload.pm

platform file from motorola kernel code

# The source files are wholly original Motorola proprietary work now being 
# licensed as BSD, the following Copyright Notice will be added to each source 
# code file, documentation and other materials with the distribution:
# 
#       Copyright  2006, Motorola, All Rights Reserved.
# 
# This program is licensed under a BSD license with the following terms:
# 
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
#
# - Redistributions of source code must retain the above copyright notice, 
#   this list of conditions and the following disclaimer. 
#
# - Redistributions in binary form must reproduce the above copyright notice, 
#   this list of conditions and the following disclaimer in the documentation 
#   and/or other materials provided with the distribution. 
#
# - Neither the name of the MOTOROLA nor the names of its contributors may be 
#   used to endorse or promote products derived from this software without 
#   specific prior written permission.
#
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.
#

package Autoload;

use strict;

use Exception;

our $AUTOLOAD;
our $Verbose = 0;

my %Hints;
my %Paths;

sub import {
	my ($pkg,$file) = caller;

	# save the caller's hints (ie. use strict/integer/etc)
	$Hints{$pkg} = $^H;

	my $path = ($file eq '-e') ? "$pkg.auto" : "$file.auto";
	$Paths{$pkg} = $Paths{File} ? File::abspath($path) : $path;

	# export autoload routine to the caller's package
	{ no strict 'refs'; *{$pkg.'::AUTOLOAD'} = \&autoload }
}

sub autoload {
	my $old_e = $@;

	my ($pkg,$func) = ($AUTOLOAD =~ /^(.*)::(.*)$/o);
	my $file = $Paths{$pkg}.'/'.$func.'.al';
	warn("autoload ${pkg}::$func() [$file]\n") if $Verbose;

	my $val;
	# impossible to set hints for a require() or do(), must eval()
	if (-e $file) {
		my $slurp;
		if (sysopen(my $fh,$file,0)) {
			local $/ = undef;
			($slurp) = (<$fh> =~ /^(.*)$/so);
			close($fh);
		} else {
			Autoload::Error->croak("open: $file: $!");
		}

		# eval the function within the package and with proper hints
		$val = eval("package $pkg; BEGIN { \$^H = $Hints{$pkg} }; $slurp");

		if ($@) {
			# fix the error message to remove the eval reference
			$@ =~ s/ at \(eval \d+\) / at /go;
			Autoload::Error->croak("Error loading $file\n$@");
		}
	} elsif ($func eq 'DESTROY') {
		# stub out unfound DESTROY methods
		$val = sub {};
	} else {
		Error->croak("Undefined subroutine &$AUTOLOAD called");
	}

	# store the returned value in the symbol table
	do {
		no strict 'refs';
		*{$AUTOLOAD} = (ref($val) eq 'CODE') ? $val : sub () { $val };
	};

	# restore saved error and jump to the loaded routine
	$@ = $old_e;
	goto(&$AUTOLOAD);
}

# load File after our package is parsed to ensure visibility of methods
use File ();

package Autoload::Error;
use base 'Error';

1;