diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/FileCache.pm | 20 | ||||
| -rw-r--r-- | lib/FileCache/t/06export.t | 62 |
3 files changed, 79 insertions, 4 deletions
@@ -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 b1a30dec3a..a64ed9a86b 100644 --- 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 index 0000000000..60f55a3182 --- /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"; + } +} |