Move Log::Message::Simple from ext/ to cpan/

[perl5.git] / lib / Exporter / Heavy.pm

diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm
index 76a5bad..724028a 100644 (file)
--- a/lib/Exporter/Heavy.pm
+++ b/lib/Exporter/Heavy.pm
@@ -5,14 +5,12 @@ no strict 'refs';
 
 # On one line so MakeMaker will see it.
 require Exporter;  our $VERSION = $Exporter::VERSION;
-$Carp::Internal{"Exporter::Heavy"} = 1;
-our $Verbose;
 
 =head1 NAME
 
 Exporter::Heavy - Exporter guts
 
-=head1 SYNOPIS
+=head1 SYNOPSIS
 
 (internal use only)
 
@@ -27,6 +25,17 @@ No user-serviceable parts inside.
 #  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".
@@ -49,22 +58,17 @@ sub heavy_export {
     };
 
     my($pkg, $callpkg, @imports) = @_;
-    my($type, $sym, $oops);
+    my($type, $sym, $cache_is_current, $oops);
     my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
-                                   \%{"${pkg}::EXPORT"});
+                                   $Exporter::Cache{$pkg} ||= {});
 
     if (@imports) {
        if (!%$export_cache) {
-           s/^&// foreach @$exports;
-           @{$export_cache}{@$exports} = (1) x @$exports;
-           my $ok = \@{"${pkg}::EXPORT_OK"};
-           if (@$ok) {
-               s/^&// foreach @$ok;
-               @{$export_cache}{@$ok} = (1) x @$ok;
-           }
+           _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;
@@ -97,7 +101,7 @@ sub heavy_export {
                }
 
                warn "Import ".($remove ? "del":"add").": @names "
-                   if $Verbose;
+                   if $Exporter::Verbose;
 
                if ($remove) {
                   foreach $sym (@names) { delete $imports{$sym} } 
@@ -109,6 +113,7 @@ sub heavy_export {
            @imports = keys %imports;
        }
 
+        my @carp;
        foreach $sym (@imports) {
            if (!$export_cache->{$sym}) {
                if ($sym =~ m/^\d/) {
@@ -126,20 +131,27 @@ sub heavy_export {
                        last;
                    }
                } elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
-                   unless ($^S) {
-                       # If we are trying to trap import of non-existent
-                       # symbols using eval, let's be silent for now and
-                       # just croak in the end.
-                       require Carp;
-                       Carp::carp(qq["$sym" is not exported by the $pkg module]);
+                   # 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++;
                    }
-                   $oops++;
                }
            }
        }
        if ($oops) {
            require Carp;
-           Carp::croak("Can't continue after import errors");
+           Carp::croak("@{carp}Can't continue after import errors");
        }
     }
     else {
@@ -147,7 +159,7 @@ sub heavy_export {
     }
 
     my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
-                              \%{"${pkg}::EXPORT_FAIL"});
+                              $Exporter::FailCache{$pkg} ||= {});
 
     if (@$fail) {
        if (!%$fail_cache) {
@@ -155,7 +167,7 @@ sub heavy_export {
            # 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 $Verbose;
+           warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
            @{$fail_cache}{@expanded} = (1) x @expanded;
        }
        my @failed;
@@ -175,13 +187,14 @@ sub heavy_export {
     }
 
     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
        (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
            unless $sym =~ s/^(\W)//;
        $type = $1;
+       no warnings 'once';
        *{"${callpkg}::$sym"} =
            $type eq '&' ? \&{"${pkg}::$sym"} :
            $type eq '$' ? \${"${pkg}::$sym"} :
@@ -218,11 +231,18 @@ sub _push_tags {
     }
 }
 
-
-sub require_version {
+sub heavy_require_version {
     my($self, $wanted) = @_;
     my $pkg = ref $self || $self;
     return ${pkg}->VERSION($wanted);
 }
 
+sub heavy_export_tags {
+  _push_tags((caller)[0], "EXPORT",    \@_);
+}
+
+sub heavy_export_ok_tags {
+  _push_tags((caller)[0], "EXPORT_OK", \@_);
+}
+
 1;