Alt-Module-Runtime-ButEUMM
view release on metacpan or search on metacpan
lib/Module/Runtime.pm view on Meta::CPAN
}
}
if($errs ne "") {
die "${errs}Can't continue after import errors ".
"at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n";
}
}
# Logic duplicated from Params::Classify. Duplicating it here avoids
# an extensive and potentially circular dependency graph.
sub _is_string($) {
my($arg) = @_;
return defined($arg) && ref(\$arg) eq "SCALAR";
}
=head1 REGULAR EXPRESSIONS
These regular expressions do not include any anchors, so to check
whether an entire string matches a syntax item you must supply the
anchors yourself.
lib/Module/Runtime.pm view on Meta::CPAN
=over
=item is_module_name(ARG)
Returns a truth value indicating whether I<ARG> is a plain string
satisfying Perl module name syntax as described for L</$module_name_rx>.
=cut
sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o }
=item is_valid_module_name(ARG)
Deprecated alias for L</is_module_name>.
=cut
*is_valid_module_name = \&is_module_name;
=item check_module_name(ARG)
Check whether I<ARG> is a plain string
satisfying Perl module name syntax as described for L</$module_name_rx>.
Return normally if it is, or C<die> if it is not.
=cut
sub check_module_name($) {
unless(&is_module_name) {
die +(_is_string($_[0]) ? "`$_[0]'" : "argument").
" is not a module name\n";
}
}
=item module_notional_filename(NAME)
Generates a notional relative filename for a module, which is used in
some Perl core interfaces.
lib/Module/Runtime.pm view on Meta::CPAN
C<die>s.
The notional filename for the named module is generated and returned.
This filename is always in Unix style, with C</> directory separators
and a C<.pm> suffix. This kind of filename can be used as an argument to
C<require>, and is the key that appears in C<%INC> to identify a module,
regardless of actual local filename syntax.
=cut
sub module_notional_filename($) {
&check_module_name;
my($name) = @_;
$name =~ s!::!/!g;
return $name.".pm";
}
=item require_module(NAME)
This is essentially the bareword form of C<require>, in runtime form.
The I<NAME> is a string, which should be a valid module name (one or
lib/Module/Runtime.pm view on Meta::CPAN
*_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
}
BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{
sub Module::Runtime::__GUARD__::DESTROY {
delete $INC{$_[0]->[0]} if @{$_[0]};
}
1;
}; die $@ if $@ ne ""; } }
sub require_module($) {
# Localise %^H to work around [perl #68590], where the bug exists
# and this is a satisfactory workaround. The bug consists of
# %^H state leaking into each required module, polluting the
# module's lexical state.
local %^H if _WORK_AROUND_HINT_LEAKAGE;
if(_WORK_AROUND_BROKEN_MODULE_STATE) {
my $notional_filename = &module_notional_filename;
my $guard = bless([ $notional_filename ],
"Module::Runtime::__GUARD__");
my $result = CORE::require($notional_filename);
lib/Module/Runtime.pm view on Meta::CPAN
ensure that the version loaded is at least the version required. This is
the same functionality provided by the I<VERSION> parameter of C<use>.
On success, the name of the module is returned. This is unlike
L</require_module>, and is done so that the entire call to L</use_module>
can be used as a class name to call a constructor, as in the example in
the synopsis.
=cut
sub use_module($;$) {
my($name, $version) = @_;
require_module($name);
$name->VERSION($version) if @_ >= 2;
return $name;
}
=item use_package_optimistically(NAME[, VERSION])
This is an analogue of L</use_module> for the situation where there is
uncertainty as to whether a package/class is defined in its own module
lib/Module/Runtime.pm view on Meta::CPAN
2.20, and on both occasions this function changed to match.
If a I<VERSION> is specified, the C<VERSION> method of the loaded package is
called with the specified I<VERSION> as an argument. This normally serves
to ensure that the version loaded is at least the version required.
On success, the name of the package is returned. These aspects of the
function work just like L</use_module>.
=cut
sub use_package_optimistically($;$) {
my($name, $version) = @_;
my $fn = module_notional_filename($name);
eval { local $SIG{__DIE__}; require_module($name); };
die $@ if $@ ne "" &&
($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s ||
$@ =~ /^Compilation\ failed\ in\ require
\ at\ \Q@{[__FILE__]}\E\ line/xm);
$name->VERSION($version) if @_ >= 2;
return $name;
}
lib/Module/Runtime.pm view on Meta::CPAN
=item is_module_spec(PREFIX, SPEC)
Returns a truth value indicating
whether I<SPEC> is valid input for L</compose_module_name>.
See below for what that entails. Whether a I<PREFIX> is supplied affects
the validity of I<SPEC>, but the exact value of the prefix is unimportant,
so this function treats I<PREFIX> as a truth value.
=cut
sub is_module_spec($$) {
my($prefix, $spec) = @_;
return _is_string($spec) &&
$spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o :
qr/\A$top_module_spec_rx\z/o);
}
=item is_valid_module_spec(PREFIX, SPEC)
Deprecated alias for L</is_module_spec>.
lib/Module/Runtime.pm view on Meta::CPAN
*is_valid_module_spec = \&is_module_spec;
=item check_module_spec(PREFIX, SPEC)
Check whether I<SPEC> is valid input for L</compose_module_name>.
Return normally if it is, or C<die> if it is not.
=cut
sub check_module_spec($$) {
unless(&is_module_spec) {
die +(_is_string($_[1]) ? "`$_[1]'" : "argument").
" is not a module specification\n";
}
}
=item compose_module_name(PREFIX, SPEC)
This function is intended to make it more convenient for a user to specify
a Perl module name at runtime. Users have greater need for abbreviations
lib/Module/Runtime.pm view on Meta::CPAN
separator, in addition to the standard C<::>. The two separators are
entirely interchangeable.
Additionally, if I<PREFIX> is not C<undef> then it must be a module
name in standard form, and it is prefixed to the user-specified name.
The user can inhibit the prefix addition by starting I<SPEC> with a
separator (either C</> or C<::>).
=cut
sub compose_module_name($$) {
my($prefix, $spec) = @_;
check_module_name($prefix) if defined $prefix;
&check_module_spec;
if($spec =~ s#\A(?:/|::)##) {
# OK
} else {
$spec = $prefix."::".$spec if defined $prefix;
}
$spec =~ s#/#::#g;
return $spec;
t/lib/t/Eval.pm view on Meta::CPAN
package t::Eval;
use warnings;
use strict;
use Test::More 0.41;
sub _ok_no_eval() {
my $lastsub = "";
my $i = 0;
while(1) {
my @c = caller($i);
unless(@c) {
ok 0;
diag "failed to find main program in stack trace";
return;
}
my $sub = $c[3];
use warnings;
use strict;
use Test::More tests => 26;
BEGIN { use_ok "Module::Runtime", qw(require_module); }
unshift @INC, "./t/lib";
my($result, $err);
sub test_require_module($) {
my($name) = @_;
$result = eval { require_module($name) };
$err = $@;
}
# a module that doesn't exist
test_require_module("t::NotExist");
like($err, qr/^Can't locate /);
# a module that's already loaded
test_require_module("t::Simple");
is($err, "");
is($result, 1);
# module file scope sees scalar context regardless of calling context
eval { require_module("t::Context"); 1 };
is $@, "";
# lexical hints don't leak through
my $have_runtime_hint_hash = "$]" >= 5.009004;
sub test_runtime_hint_hash($$) {
SKIP: {
skip "no runtime hint hash", 1 unless $have_runtime_hint_hash;
is +((caller(0))[10] || {})->{$_[0]}, $_[1];
}
}
SKIP: {
skip "core bug makes this test crash", 13
if "$]" >= 5.008 && "$]" < 5.008004;
skip "can't work around hint leakage in pure Perl", 13
if "$]" >= 5.009004 && "$]" < 5.010001;
$result = eval { use_module("t::Simple") };
is($@, "");
is($result, "t::Simple");
# module file scope sees scalar context regardless of calling context
$result = eval { use_module("t::Context"); 1 };
is $@, "";
# lexical hints don't leak through
my $have_runtime_hint_hash = "$]" >= 5.009004;
sub test_runtime_hint_hash($$) {
SKIP: {
skip "no runtime hint hash", 1 unless $have_runtime_hint_hash;
is +((caller(0))[10] || {})->{$_[0]}, $_[1];
}
}
SKIP: {
skip "core bug makes this test crash", 13
if "$]" >= 5.008 && "$]" < 5.008004;
skip "can't work around hint leakage in pure Perl", 13
if "$]" >= 5.009004 && "$]" < 5.010001;
# a module that we'll load now
$result = eval { use_package_optimistically("t::Simple") };
is $@, "";
is $result, "t::Simple";
no strict "refs";
ok defined(${"t::Simple::VERSION"});
# lexical hints don't leak through
my $have_runtime_hint_hash = "$]" >= 5.009004;
sub test_runtime_hint_hash($$) {
SKIP: {
skip "no runtime hint hash", 1 unless $have_runtime_hint_hash;
is +((caller(0))[10] || {})->{$_[0]}, $_[1];
}
}
SKIP: {
skip "core bug makes this test crash", 13
if "$]" >= 5.008 && "$]" < 5.008004;
skip "can't work around hint leakage in pure Perl", 13
if "$]" >= 5.009004 && "$]" < 5.010001;
( run in 0.308 second using v1.01-cache-2.11-cpan-65fba6d93b7 )