Re: [perl #32949] FileCache only works in "main" package

From: "Jos I. Boumans" <kane@xs4all.net>
Message-Id: <7728A4F5-491C-11D9-9CA3-000A95EF62E2@xs4all.net>

p4raw-id: //depot/perl@23627

diff --git a/MANIFEST b/MANIFEST
index 8e492f3..51e601e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1345,6 +1345,7 @@ lib/FileCache/t/02maxopen.t       See if FileCache works
 lib/FileCache/t/03append.t     See if FileCache works
 lib/FileCache/t/04twoarg.t     See if FileCache works
 lib/FileCache/t/05override.t   See if FileCache works
+lib/FileCache/t/06export.t     See if FileCache exporting works
 lib/File/CheckTree.pm          Perl module supporting wholesale file mode validation
 lib/File/CheckTree.t           See if File::CheckTree works
 lib/File/Compare.pm            Emulation of cmp command

diff --git a/lib/FileCache.pm b/lib/FileCache.pm
index b1a30de..a64ed9a 100644 (file)
--- a/lib/FileCache.pm
+++ b/lib/FileCache.pm
@@ -84,15 +84,27 @@ no strict 'refs';
 # These are not C<my> for legacy reasons.
 # Previous versions requested the user set $cacheout_maxopen by hand.
 # Some authors fiddled with %saw to overcome the clobber on initial open.
-use vars qw(%saw $cacheout_maxopen);
+use vars qw(%saw $cacheout_maxopen @EXPORT);
 my %isopen;
 my $cacheout_seq = 0;
 
 sub import {
     my ($pkg,%args) = @_;
-    $pkg = caller(1);
-    *{$pkg.'::cacheout'} = \&cacheout;
-    *{$pkg.'::close'}    = \&cacheout_close;
+
+    # Not using Exporter is naughty.
+    # Also, using caller(1) is just wrong.
+    #$pkg = caller(1);
+    #*{$pkg.'::cacheout'} = \&cacheout;
+    #*{$pkg.'::close'}    = \&cacheout_close;
+
+    # Use Exporter. %args are for us, not Exporter.
+    # Make sure to up export_to_level, or we will import into ourselves,
+    # rather than our calling package;
+    use base 'Exporter';
+    @EXPORT = qw[cacheout cacheout_close];
+
+    __PACKAGE__->export_to_level(1);
+    Exporter::import( $pkg );
 
     # Truth is okay here because setting maxopen to 0 would be bad
     return $cacheout_maxopen = $args{maxopen} if $args{maxopen};

diff --git a/lib/FileCache/t/06export.t b/lib/FileCache/t/06export.t
new file mode 100644 (file)
index 0000000..60f55a3
--- /dev/null
+++ b/lib/FileCache/t/06export.t
@@ -0,0 +1,62 @@
+#!./perl
+BEGIN {
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+
+    # Functions exported by FileCache;
+    @funcs  = qw[cacheout cacheout_close];
+    $i      = 0;
+    
+    # number of tests
+    print "1..8\n";
+}
+
+# Test 6: Test that exporting both works to package main and
+# other packages. Now using Exporter.
+
+# First, we shouldn't be able to have these in our namespace
+# Add them to BEGIN so the later 'use' doesn't influence this
+# test
+BEGIN {   
+    for my $f (@funcs) {
+        ++$i;
+        print 'not ' if __PACKAGE__->can($f);
+        print "ok $i\n"; 
+    }
+}
+
+# With an empty import list, we also shouldn't have them in
+# our namespace.
+# Add them to BEGIN so the later 'use' doesn't influence this
+# test
+BEGIN {   
+    use FileCache ();
+    for my $f (@funcs) {
+        ++$i;
+        print 'not ' if __PACKAGE__->can($f);
+        print "ok $i\n"; 
+    }
+}
+
+
+# Now, we use FileCache in 'main'
+{   use FileCache;
+    for my $f (@funcs) {
+        ++$i;
+        print 'not ' if !__PACKAGE__->can($f);
+        print "ok $i\n"; 
+    }
+}
+
+# Now we use them in another package
+{   package X;
+    use FileCache;
+    for my $f (@main::funcs) {
+        ++$main::i;
+        print 'not ' if !__PACKAGE__->can($f);
+        print "ok $main::i\n"; 
+    }
+}