2cc792288f044034a09d82abded1fe190fed808e
# On one line so MakeMaker will see it.
require Exporter
; our $VERSION = $Exporter::VERSION
;
$Carp::Internal
{"Exporter::Heavy"} = 1;
Exporter::Heavy - Exporter guts
No user-serviceable parts inside.
# We go to a lot of trouble not to 'require Carp' at file scope,
# because Carp requires Exporter, and something has to give.
my ($pkg, $exports, $cache) = @_;
s/^&// foreach @
$exports;
@
{$cache}{@
$exports} = (1) x @
$exports;
my $ok = \@
{"${pkg}::EXPORT_OK"};
@
{$cache}{@
$ok} = (1) x @
$ok;
# First make import warnings look like they're coming from the "use".
local $SIG{__WARN__
} = sub {
if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
local $Carp::CarpLevel
= 1; # ignore package calling us too.
local $SIG{__DIE__
} = sub {
local $Carp::CarpLevel
= 1; # ignore package calling us too.
Carp
::croak
("$_[0]Illegal null symbol in \@${1}::EXPORT")
if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
my($pkg, $callpkg, @imports) = @_;
my($type, $sym, $cache_is_current, $oops);
my($exports, $export_cache) = (\@
{"${pkg}::EXPORT"},
$Exporter::Cache
{$pkg} ||= {});
_rebuild_cache
($pkg, $exports, $export_cache);
if (grep m{^[/!:]}, @imports) {
my $tagsref = \
%{"${pkg}::EXPORT_TAGS"};
my($remove, $spec, @names, @allexports);
# negated first item implies starting with default set:
unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
foreach $spec (@imports){
$remove = $spec =~ s/^!//;
elsif ($tagdata = $tagsref->{$spec}) {
warn qq["$spec" is
not defined in %${pkg
}::EXPORT_TAGS
];
elsif ($spec =~ m
:^/(.*)/$:){
@allexports = keys %$export_cache unless @allexports; # only do keys once
@names = grep(/$patn/, @allexports); # not anchored by default
@names = ($spec); # is a normal symbol name
warn "Import ".($remove ?
"del":"add").": @names "
foreach $sym (@names) { delete $imports{$sym} }
@imports{@names} = (1) x
@names;
@imports = keys %imports;
foreach $sym (@imports) {
if (!$export_cache->{$sym}) {
$pkg->VERSION($sym); # inherit from UNIVERSAL
# If the version number was the only thing specified
# then we should act as if nothing was specified:
# We need a way to emulate 'use Foo ()' but still
# allow an easy version check: "use Foo 1.23, ''";
if (@imports == 2 and !$imports[1]) {
} elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
# Last chance - see if they've updated EXPORT_OK since we
unless ($cache_is_current) {
_rebuild_cache
($pkg, $exports, $export_cache);
if (!$export_cache->{$sym}) {
# accumulate the non-exports
qq["$sym" is
not exported by the
$pkg module
\n];
Carp
::croak
("@{carp}Can't continue after import errors");
my($fail, $fail_cache) = (\@
{"${pkg}::EXPORT_FAIL"},
$Exporter::FailCache
{$pkg} ||= {});
# Build cache of symbols. Optimise the lookup by adding
# barewords twice... both with and without a leading &.
# (Technique could be applied to $export_cache at cost of memory)
my @expanded = map { /^\w/ ?
($_, '&'.$_) : $_ } @
$fail;
warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose
;
@
{$fail_cache}{@expanded} = (1) x
@expanded;
foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
@failed = $pkg->export_fail(@failed);
Carp
::carp
(qq["$sym" is
not implemented by the
$pkg module
],
Carp
::croak
("Can't continue after import errors");
warn "Importing into $callpkg from $pkg: ",
join(", ",sort @imports) if $Exporter::Verbose
;
foreach $sym (@imports) {
# shortcut for the common case of no type character
(*{"${callpkg}::$sym"} = \
&{"${pkg}::$sym"}, next)
unless $sym =~ s/^(\W)//;
$type eq '&' ? \
&{"${pkg}::$sym"} :
$type eq '$' ? \
${"${pkg}::$sym"} :
$type eq '@' ? \@
{"${pkg}::$sym"} :
$type eq '%' ? \
%{"${pkg}::$sym"} :
$type eq '*' ?
*{"${pkg}::$sym"} :
do { require Carp
; Carp
::croak
("Can't export symbol: $type$sym") };
sub heavy_export_to_level
(undef) = shift; # XXX redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
my($pkg, $var, $syms) = @_;
my $export_tags = \
%{"${pkg}::EXPORT_TAGS"};
map { $export_tags->{$_} ? @
{$export_tags->{$_}}
: scalar(push(@nontag,$_),$_) }
(@
$syms) ? @
$syms : keys %$export_tags);
# This may change to a die one day
Carp
::carp
(join(", ", @nontag)." are not tags of $pkg");
sub heavy_require_version
{
my $pkg = ref $self || $self;
return ${pkg
}->VERSION($wanted);
_push_tags
((caller)[0], "EXPORT", \
@_);
sub heavy_export_ok_tags
{
_push_tags
((caller)[0], "EXPORT_OK", \
@_);