-package Exporter;
+package Exporter::Heavy;
+
+use strict;
+no strict 'refs';
+
+# On one line so MakeMaker will see it.
+require Exporter; our $VERSION = $Exporter::VERSION;
+# Carp does this now for us, so we can finally live w/o Carp
+#$Carp::Internal{"Exporter::Heavy"} = 1;
=head1 NAME
Exporter::Heavy - Exporter guts
-=head1 SYNOPIS
+=head1 SYNOPSIS
(internal use only)
=head1 DESCRIPTION
No user-serviceable parts inside.
-
+
=cut
+
#
# We go to a lot of trouble not to 'require Carp' at file scope,
# because Carp requires Exporter, and something has to give.
#
+sub _rebuild_cache {
+ my ($pkg, $exports, $cache) = @_;
+ s/^&// foreach @$exports;
+ @{$cache}{@$exports} = (1) x @$exports;
+ my $ok = \@{"${pkg}::EXPORT_OK"};
+ if (@$ok) {
+ s/^&// foreach @$ok;
+ @{$cache}{@$ok} = (1) x @$ok;
+ }
+}
+
sub heavy_export {
# First make import warnings look like they're coming from the "use".
};
my($pkg, $callpkg, @imports) = @_;
- my($type, $sym, $oops);
- *exports = *{"${pkg}::EXPORT"};
+ my($type, $sym, $cache_is_current, $oops);
+ my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
+ $Exporter::Cache{$pkg} ||= {});
if (@imports) {
- if (!%exports) {
- grep(s/^&//, @exports);
- @exports{@exports} = (1) x @exports;
- my $ok = \@{"${pkg}::EXPORT_OK"};
- if (@$ok) {
- grep(s/^&//, @$ok);
- @exports{@$ok} = (1) x @$ok;
- }
+ if (!%$export_cache) {
+ _rebuild_cache ($pkg, $exports, $export_cache);
+ $cache_is_current = 1;
}
- if ($imports[0] =~ m#^[/!:]#){
+ if (grep m{^[/!:]}, @imports) {
my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
my $tagdata;
my %imports;
if ($spec =~ s/^://){
if ($spec eq 'DEFAULT'){
- @names = @exports;
+ @names = @$exports;
}
elsif ($tagdata = $tagsref->{$spec}) {
@names = @$tagdata;
}
elsif ($spec =~ m:^/(.*)/$:){
my $patn = $1;
- @allexports = keys %exports unless @allexports; # only do keys once
+ @allexports = keys %$export_cache unless @allexports; # only do keys once
@names = grep(/$patn/, @allexports); # not anchored by default
}
else {
}
warn "Import ".($remove ? "del":"add").": @names "
- if $Verbose;
+ if $Exporter::Verbose;
if ($remove) {
foreach $sym (@names) { delete $imports{$sym} }
@imports = keys %imports;
}
+ my @carp;
foreach $sym (@imports) {
- if (!$exports{$sym}) {
+ if (!$export_cache->{$sym}) {
if ($sym =~ m/^\d/) {
- $pkg->require_version($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:
if (@imports == 1) {
- @imports = @exports;
+ @imports = @$exports;
last;
}
# We need a way to emulate 'use Foo ()' but still
@imports = ();
last;
}
- } elsif ($sym !~ s/^&// || !$exports{$sym}) {
- require Carp;
- Carp::carp(qq["$sym" is not exported by the $pkg module]);
- $oops++;
+ } elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
+ # Last chance - see if they've updated EXPORT_OK since we
+ # cached it.
+
+ unless ($cache_is_current) {
+ %$export_cache = ();
+ _rebuild_cache ($pkg, $exports, $export_cache);
+ $cache_is_current = 1;
+ }
+
+ if (!$export_cache->{$sym}) {
+ # accumulate the non-exports
+ push @carp,
+ qq["$sym" is not exported by the $pkg module\n];
+ $oops++;
+ }
}
}
}
if ($oops) {
require Carp;
- Carp::croak("Can't continue after import errors");
+ Carp::croak("@{carp}Can't continue after import errors");
}
}
else {
- @imports = @exports;
+ @imports = @$exports;
}
- *fail = *{"${pkg}::EXPORT_FAIL"};
- if (@fail) {
- if (!%fail) {
+ my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
+ $Exporter::FailCache{$pkg} ||= {});
+
+ if (@$fail) {
+ if (!%$fail_cache) {
# Build cache of symbols. Optimise the lookup by adding
# barewords twice... both with and without a leading &.
- # (Technique could be applied to %exports cache at cost of memory)
- my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
- warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
- @fail{@expanded} = (1) x @expanded;
+ # (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;
}
my @failed;
- foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+ foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
if (@failed) {
@failed = $pkg->export_fail(@failed);
foreach $sym (@failed) {
}
warn "Importing into $callpkg from $pkg: ",
- join(", ",sort @imports) if $Verbose;
+ join(", ",sort @imports) if $Exporter::Verbose;
foreach $sym (@imports) {
# shortcut for the common case of no type character
sub _push_tags {
my($pkg, $var, $syms) = @_;
- my $nontag;
- *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+ my @nontag = ();
+ my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
push(@{"${pkg}::$var"},
- map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
- (@$syms) ? @$syms : keys %export_tags);
- if ($nontag and $^W) {
+ map { $export_tags->{$_} ? @{$export_tags->{$_}}
+ : scalar(push(@nontag,$_),$_) }
+ (@$syms) ? @$syms : keys %$export_tags);
+ if (@nontag and $^W) {
# This may change to a die one day
require Carp;
- Carp::carp("Some names are not tags");
+ Carp::carp(join(", ", @nontag)." are not tags of $pkg");
}
}
-# Default methods
+sub heavy_require_version {
+ my($self, $wanted) = @_;
+ my $pkg = ref $self || $self;
+ return ${pkg}->VERSION($wanted);
+}
-sub export_fail {
- my $self = shift;
- @_;
+sub heavy_export_tags {
+ _push_tags((caller)[0], "EXPORT", \@_);
}
-sub require_version {
- my($self, $wanted) = @_;
- my $pkg = ref $self || $self;
- my $version = ${"${pkg}::VERSION"};
- if (!$version or $version < $wanted) {
- $version ||= "(undef)";
- # %INC contains slashes, but $pkg contains double-colons.
- my $file = (map {s,::,/,g; $INC{$_}} "$pkg.pm")[0];
- $file &&= " ($file)";
- require Carp;
- Carp::croak("$pkg $wanted required--this is only version $version$file")
- }
- $version;
+sub heavy_export_ok_tags {
+ _push_tags((caller)[0], "EXPORT_OK", \@_);
}
1;
https://perl5.git.perl.org / perl5.git / blobdiff