forked from schacon/perl
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Message-ID: <9866.194.109.0.185.1155119022.squirrel@webmail.xs4all.nl> p4raw-id: //depot/perl@28695
- Loading branch information
Jos I. Boumans
authored and
Steve Hay
committed
Aug 11, 2006
1 parent
c84ba4c
commit 0819efc
Showing
9 changed files
with
302 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,173 @@ | ||
package Module::Load; | ||
|
||
$VERSION = '0.10'; | ||
|
||
use strict; | ||
use File::Spec (); | ||
|
||
sub import { | ||
my $who = _who(); | ||
|
||
{ no strict 'refs'; | ||
*{"${who}::load"} = *load; | ||
} | ||
} | ||
|
||
sub load (*;@) { | ||
my $mod = shift or return; | ||
my $who = _who(); | ||
|
||
if( _is_file( $mod ) ) { | ||
require $mod; | ||
} else { | ||
LOAD: { | ||
my $err; | ||
for my $flag ( qw[1 0] ) { | ||
my $file = _to_file( $mod, $flag); | ||
eval { require $file }; | ||
$@ ? $err .= $@ : last LOAD; | ||
} | ||
die $err if $err; | ||
} | ||
} | ||
__PACKAGE__->_export_to_level(1, $mod, @_) if @_; | ||
} | ||
|
||
### 5.004's Exporter doesn't have export_to_level. | ||
### Taken from Michael Schwerns Test::More and slightly modified | ||
sub _export_to_level { | ||
my $pkg = shift; | ||
my $level = shift; | ||
my $mod = shift; | ||
my $callpkg = caller($level); | ||
|
||
$mod->export($callpkg, @_); | ||
} | ||
|
||
sub _to_file{ | ||
local $_ = shift; | ||
my $pm = shift || ''; | ||
|
||
my @parts = split /::/; | ||
|
||
### because of [perl #19213], see caveats ### | ||
my $file = $^O eq 'MSWin32' | ||
? join "/", @parts | ||
: File::Spec->catfile( @parts ); | ||
|
||
$file .= '.pm' if $pm; | ||
|
||
return $file; | ||
} | ||
|
||
sub _who { (caller(1))[0] } | ||
|
||
sub _is_file { | ||
local $_ = shift; | ||
return /^\./ ? 1 : | ||
/[^\w:']/ ? 1 : | ||
undef | ||
#' silly bbedit.. | ||
} | ||
|
||
|
||
1; | ||
|
||
__END__ | ||
=pod | ||
=head1 NAME | ||
Module::Load - runtime require of both modules and files | ||
=head1 SYNOPSIS | ||
use Module::Load; | ||
my $module = 'Data:Dumper'; | ||
load Data::Dumper; # loads that module | ||
load 'Data::Dumper'; # ditto | ||
load $module # tritto | ||
my $script = 'some/script.pl' | ||
load $script; | ||
load 'some/script.pl'; # use quotes because of punctuations | ||
load thing; # try 'thing' first, then 'thing.pm' | ||
load CGI, ':standard' # like 'use CGI qw[:standard]' | ||
=head1 DESCRIPTION | ||
C<load> eliminates the need to know whether you are trying to require | ||
either a file or a module. | ||
If you consult C<perldoc -f require> you will see that C<require> will | ||
behave differently when given a bareword or a string. | ||
In the case of a string, C<require> assumes you are wanting to load a | ||
file. But in the case of a bareword, it assumes you mean a module. | ||
This gives nasty overhead when you are trying to dynamically require | ||
modules at runtime, since you will need to change the module notation | ||
(C<Acme::Comment>) to a file notation fitting the particular platform | ||
you are on. | ||
C<load> eliminates the need for this overhead and will just DWYM. | ||
=head1 Rules | ||
C<load> has the following rules to decide what it thinks you want: | ||
=over 4 | ||
=item * | ||
If the argument has any characters in it other than those matching | ||
C<\w>, C<:> or C<'>, it must be a file | ||
=item * | ||
If the argument matches only C<[\w:']>, it must be a module | ||
=item * | ||
If the argument matches only C<\w>, it could either be a module or a | ||
file. We will try to find C<file> first in C<@INC> and if that fails, | ||
we will try to find C<file.pm> in @INC. | ||
If both fail, we die with the respective error messages. | ||
=back | ||
=head1 Caveats | ||
Because of a bug in perl (#19213), at least in version 5.6.1, we have | ||
to hardcode the path separator for a require on Win32 to be C</>, like | ||
on Unix rather than the Win32 C<\>. Otherwise perl will not read its | ||
own %INC accurately double load files if they are required again, or | ||
in the worst case, core dump. | ||
C<Module::Load> cannot do implicit imports, only explicit imports. | ||
(in other words, you always have to specify explicitly what you wish | ||
to import from a module, even if the functions are in that modules' | ||
C<@EXPORT>) | ||
=head1 AUTHOR | ||
This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. | ||
Thanks to Jonas B. Nielsen for making explicit imports work. | ||
=head1 COPYRIGHT | ||
This module is | ||
copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>. | ||
All rights reserved. | ||
This library is free software; | ||
you may redistribute and/or modify it under the same | ||
terms as Perl itself. | ||
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,68 @@ | ||
### Module::Load test suite ### | ||
BEGIN { | ||
if( $ENV{PERL_CORE} ) { | ||
chdir '../lib/Module/Load' if -d '../lib/Module/Load'; | ||
unshift @INC, '../../..'; | ||
} | ||
} | ||
|
||
BEGIN { chdir 't' if -d 't' } | ||
|
||
use strict; | ||
use lib qw[../lib to_load]; | ||
use Module::Load; | ||
use Test::More tests => 13; | ||
|
||
|
||
{ | ||
my $mod = 'Must::Be::Loaded'; | ||
my $file = Module::Load::_to_file($mod,1); | ||
|
||
eval { load $mod }; | ||
|
||
is( $@, '', qq[Loading module '$mod'] ); | ||
ok( defined($INC{$file}), q[... found in %INC] ); | ||
} | ||
|
||
{ | ||
my $mod = 'LoadMe.pl'; | ||
my $file = Module::Load::_to_file($mod); | ||
|
||
eval { load $mod }; | ||
|
||
is( $@, '', qq[Loading File '$mod'] ); | ||
ok( defined($INC{$file}), q[... found in %INC] ); | ||
} | ||
|
||
{ | ||
my $mod = 'LoadIt'; | ||
my $file = Module::Load::_to_file($mod,1); | ||
|
||
eval { load $mod }; | ||
|
||
is( $@, '', qq[Loading Ambigious Module '$mod'] ); | ||
ok( defined($INC{$file}), q[... found in %INC] ); | ||
} | ||
|
||
{ | ||
my $mod = 'ToBeLoaded'; | ||
my $file = Module::Load::_to_file($mod); | ||
|
||
eval { load $mod }; | ||
|
||
is( $@, '', qq[Loading Ambigious File '$mod'] ); | ||
ok( defined($INC{$file}), q[... found in %INC] ); | ||
} | ||
|
||
### Test importing functions ### | ||
{ my $mod = 'TestModule'; | ||
my @funcs = qw[func1 func2]; | ||
|
||
eval { load $mod, @funcs }; | ||
is( $@, '', qq[Loaded exporter module '$mod'] ); | ||
|
||
for my $func (@funcs) { | ||
ok( $mod->can($func), "$mod -> can( $func )" ); | ||
ok( __PACKAGE__->can($func), "we -> can ( $func )" ); | ||
} | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,3 @@ | ||
$VERSION = 1; | ||
|
||
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,3 @@ | ||
$VERSION = 0.01; | ||
|
||
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
package TestModule; | ||
|
||
use strict; | ||
require Exporter; | ||
use vars qw(@EXPORT @EXPORT_OK @ISA); | ||
|
||
@ISA = qw(Exporter); | ||
@EXPORT = qw(func2); | ||
@EXPORT_OK = qw(func1); | ||
|
||
sub func1 { return "func1"; } | ||
|
||
sub func2 { return "func2"; } | ||
|
||
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,30 @@ | ||
# Below is a sample of a config file you could use | ||
|
||
# comments are denoted by a single '#' | ||
# use a shared stack, or have a private instance? | ||
# if none provided, set to '0', | ||
private = 1 | ||
|
||
# do not be verbose | ||
verbose = 0 | ||
|
||
# default tag to set on new items | ||
# if none provided, set to 'NONE' | ||
tag = SOME TAG | ||
|
||
# default level to handle items | ||
# if none provided, set to 'log' | ||
level = carp | ||
|
||
# extra files to include | ||
# if none provided, no files are auto included | ||
include = LoadMe.pl | ||
|
||
# automatically delete items | ||
# when you retrieve them from the stack? | ||
# if none provided, set to '0' | ||
remove = 1 | ||
|
||
# retrieve errors in chronological order, or not? | ||
# if none provided, set to '1' | ||
chrono = 0 |