1N/Apackage autouse;
1N/A
1N/A#use strict; # debugging only
1N/Ause 5.003_90; # ->can, for my $var
1N/A
1N/A$autouse::VERSION = '1.03';
1N/A
1N/A$autouse::DEBUG ||= 0;
1N/A
1N/Asub vet_import ($);
1N/A
1N/Asub croak {
1N/A require Carp;
1N/A Carp::croak(@_);
1N/A}
1N/A
1N/Asub import {
1N/A my $class = @_ ? shift : 'autouse';
1N/A croak "usage: use $class MODULE [,SUBS...]" unless @_;
1N/A my $module = shift;
1N/A
1N/A (my $pm = $module) =~ s{::}{/}g;
1N/A $pm .= '.pm';
1N/A if (exists $INC{$pm}) {
1N/A vet_import $module;
1N/A local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
1N/A # $Exporter::Verbose = 1;
1N/A return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_);
1N/A }
1N/A
1N/A # It is not loaded: need to do real work.
1N/A my $callpkg = caller(0);
1N/A print "autouse called from $callpkg\n" if $autouse::DEBUG;
1N/A
1N/A my $index;
1N/A for my $f (@_) {
1N/A my $proto;
1N/A $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
1N/A
1N/A my $closure_import_func = $func; # Full name
1N/A my $closure_func = $func; # Name inside package
1N/A my $index = rindex($func, '::');
1N/A if ($index == -1) {
1N/A $closure_import_func = "${callpkg}::$func";
1N/A } else {
1N/A $closure_func = substr $func, $index + 2;
1N/A croak "autouse into different package attempted"
1N/A unless substr($func, 0, $index) eq $module;
1N/A }
1N/A
1N/A my $load_sub = sub {
1N/A unless ($INC{$pm}) {
1N/A eval {require $pm};
1N/A die if $@;
1N/A vet_import $module;
1N/A }
1N/A no warnings 'redefine';
1N/A *$closure_import_func = \&{"${module}::$closure_func"};
1N/A print "autousing $module; "
1N/A ."imported $closure_func as $closure_import_func\n"
1N/A if $autouse::DEBUG;
1N/A goto &$closure_import_func;
1N/A };
1N/A
1N/A if (defined $proto) {
1N/A *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
1N/A } else {
1N/A *$closure_import_func = $load_sub;
1N/A }
1N/A }
1N/A}
1N/A
1N/Asub vet_import ($) {
1N/A my $module = shift;
1N/A if (my $import = $module->can('import')) {
1N/A croak "autoused module has unique import() method"
1N/A unless defined(&Exporter::import)
1N/A && $import == \&Exporter::import;
1N/A }
1N/A}
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/Aautouse - postpone load of modules until a function is used
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use autouse 'Carp' => qw(carp croak);
1N/A carp "this carp was predeclared and autoused ";
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AIf the module C<Module> is already loaded, then the declaration
1N/A
1N/A use autouse 'Module' => qw(func1 func2($;$));
1N/A
1N/Ais equivalent to
1N/A
1N/A use Module qw(func1 func2);
1N/A
1N/Aif C<Module> defines func2() with prototype C<($;$)>, and func1() has
1N/Ano prototypes. (At least if C<Module> uses C<Exporter>'s C<import>,
1N/Aotherwise it is a fatal error.)
1N/A
1N/AIf the module C<Module> is not loaded yet, then the above declaration
1N/Adeclares functions func1() and func2() in the current package. When
1N/Athese functions are called, they load the package C<Module> if needed,
1N/Aand substitute themselves with the correct definitions.
1N/A
1N/A=begin _deprecated
1N/A
1N/A use Module qw(Module::func3);
1N/A
1N/Awill work and is the equivalent to:
1N/A
1N/A use Module qw(func3);
1N/A
1N/AIt is not a very useful feature and has been deprecated.
1N/A
1N/A=end _deprecated
1N/A
1N/A
1N/A=head1 WARNING
1N/A
1N/AUsing C<autouse> will move important steps of your program's execution
1N/Afrom compile time to runtime. This can
1N/A
1N/A=over 4
1N/A
1N/A=item *
1N/A
1N/ABreak the execution of your program if the module you C<autouse>d has
1N/Asome initialization which it expects to be done early.
1N/A
1N/A=item *
1N/A
1N/Ahide bugs in your code since important checks (like correctness of
1N/Aprototypes) is moved from compile time to runtime. In particular, if
1N/Athe prototype you specified on C<autouse> line is wrong, you will not
1N/Afind it out until the corresponding function is executed. This will be
1N/Avery unfortunate for functions which are not always called (note that
1N/Afor such functions C<autouse>ing gives biggest win, for a workaround
1N/Asee below).
1N/A
1N/A=back
1N/A
1N/ATo alleviate the second problem (partially) it is advised to write
1N/Ayour scripts like this:
1N/A
1N/A use Module;
1N/A use autouse Module => qw(carp($) croak(&$));
1N/A carp "this carp was predeclared and autoused ";
1N/A
1N/AThe first line ensures that the errors in your argument specification
1N/Aare found early. When you ship your application you should comment
1N/Aout the first line, since it makes the second one useless.
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AIlya Zakharevich (ilya@math.ohio-state.edu)
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/Aperl(1).
1N/A
1N/A=cut