view release on metacpan or  search on metacpan

lib/Module/Runtime.pm  view on Meta::CPAN

package Module::Runtime;

# Don't "use 5.006" here, because Perl 5.15.6 will load feature.pm if
# the version check is done that way.
BEGIN { require 5.006; }
# Don't "use warnings" here, to avoid dependencies.  Do standardise the
# warning status by lexical override; unfortunately the only safe bitset
# to build in is the empty set, equivalent to "no warnings".
BEGIN { ${^WARNING_BITS} = ""; }
# Don't "use strict" here, to avoid dependencies.

our $VERSION = '0.018';

# Don't use Exporter here, to avoid dependencies.
our @EXPORT_OK = qw(
    $module_name_rx is_module_name is_valid_module_name check_module_name
    module_notional_filename require_module
    use_module use_package_optimistically
    $top_module_spec_rx $sub_module_spec_rx
    is_module_spec is_valid_module_spec check_module_spec
    compose_module_name
);
my %export_ok = map { ($_ => undef) } @EXPORT_OK;
sub import {
    my $me = shift;
    my $callpkg = caller;
    my $errs = "";
    foreach(@_) {
        if(exists $export_ok{$_}) {
            # We would need to do "no strict 'refs'" here
            # if we had enabled strict at file scope.
            if(/\A\$(.*)\z/s) {
                *{$callpkg."::".$1} = \$$1;
            } else {
                *{$callpkg."::".$_} = \&$_;
            }
        } else {
            $errs .= "\"$_\" is not exported by the $me module\n";
        }
    }
    if($errs ne "") {
        die sprintf "%sCan't continue after import errors at %s line %u.\n",
            $errs, (caller)[1,2];
    }
}

# 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";
}

our $module_name_rx = qr{[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*};

my $qual_module_spec_rx =
    qr{(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*};

my $unqual_top_module_spec_rx =
    qr{[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*};

our $top_module_spec_rx = qr{$qual_module_spec_rx|$unqual_top_module_spec_rx};

my $unqual_sub_module_spec_rx = qr{[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*};

our $sub_module_spec_rx = qr{$qual_module_spec_rx|$unqual_sub_module_spec_rx};

sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o }

*is_valid_module_name = \&is_module_name;

sub check_module_name($) {
    unless(&is_module_name) {
        die +(_is_string($_[0]) ? "`$_[0]'" : "argument").
            " is not a module name\n";
    }
}

sub module_notional_filename($) {
    &check_module_name;
    my($name) = @_;
    $name =~ s{::}{/}g;
    return $name.".pm";
}

# Don't "use constant" here, to avoid dependencies.
BEGIN {
    ## no critic (ValuesAndExpressions::ProhibitMismatchedOperators)
    *_WORK_AROUND_HINT_LEAKAGE =
        "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
            ? sub(){1} : sub(){0};
    *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
}

BEGIN {
    if(_WORK_AROUND_BROKEN_MODULE_STATE) {
        eval <<'END_CODE' or die $@; ## no critic (BuiltinFunctions::ProhibitStringyEval)
            sub Module::Runtime::__GUARD__::DESTROY {
                delete $INC{$_[0]->[0]} if @{$_[0]};
            }
            1;
END_CODE
    }