Move FileCache from lib to ext

At the same time, remove PERL_CORE logic from tests and convert tests to
use Test::More instead of t/test.pl.

9 files changed, 1 insertions, 464 deletions

diff --git a/lib/.gitignore b/lib/.gitignore
index 9076d3d609..ac4264ea9d 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -21,6 +21,7 @@
 /Errno.pm
 /ExtUtils/Miniperl.pm
 /Fcntl.pm
+/FileCache.pm
 /File/Fetch.pm
 /File/Glob.pm
 /File/GlobMapper.pm
diff --git a/lib/FileCache.pm b/lib/FileCache.pm
deleted file mode 100644
index 09583b04af..0000000000
--- a/lib/FileCache.pm
+++ /dev/null
@@ -1,188 +0,0 @@
-package FileCache;
-
-our $VERSION = '1.08';
-
-=head1 NAME
-
-FileCache - keep more files open than the system permits
-
-=head1 SYNOPSIS
-
-    no strict 'refs';
-
-    use FileCache;
-    # or
-    use FileCache maxopen => 16;
-
-    cacheout $mode, $path;
-    # or
-    cacheout $path;
-    print $path @data;
-
-    $fh = cacheout $mode, $path;
-    # or
-    $fh = cacheout $path;
-    print $fh @data;
-
-=head1 DESCRIPTION
-
-The C<cacheout> function will make sure that there's a filehandle open
-for reading or writing available as the pathname you give it. It
-automatically closes and re-opens files if you exceed your system's
-maximum number of file descriptors, or the suggested maximum I<maxopen>.
-
-=over
-
-=item cacheout EXPR
-
-The 1-argument form of cacheout will open a file for writing (C<< '>' >>)
-on it's first use, and appending (C<<< '>>' >>>) thereafter.
-
-Returns EXPR on success for convenience. You may neglect the
-return value and manipulate EXPR as the filehandle directly if you prefer.
-
-=item cacheout MODE, EXPR
-
-The 2-argument form of cacheout will use the supplied mode for the initial
-and subsequent openings. Most valid modes for 3-argument C<open> are supported
-namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
-C< '|-' > and C< '-|' >
-
-To pass supplemental arguments to a program opened with C< '|-' > or C< '-|' >
-append them to the command string as you would system EXPR.
-
-Returns EXPR on success for convenience. You may neglect the
-return value and manipulate EXPR as the filehandle directly if you prefer.
-
-=back
-
-=head1 CAVEATS
-
-While it is permissible to C<close> a FileCache managed file,
-do not do so if you are calling C<FileCache::cacheout> from a package other
-than which it was imported, or with another module which overrides C<close>.
-If you must, use C<FileCache::cacheout_close>.
-
-Although FileCache can be used with piped opens ('-|' or '|-') doing so is
-strongly discouraged.  If FileCache finds it necessary to close and then reopen
-a pipe, the command at the far end of the pipe will be reexecuted - the results
-of performing IO on FileCache'd pipes is unlikely to be what you expect.  The
-ability to use FileCache on pipes may be removed in a future release.
-
-FileCache does not store the current file offset if it finds it necessary to
-close a file.  When the file is reopened, the offset will be as specified by the
-original C<open> file mode.  This could be construed to be a bug.
-
-The module functionality relies on symbolic references, so things will break
-under 'use strict' unless 'no strict "refs"' is also specified.
-
-=head1 BUGS
-
-F<sys/param.h> lies with its C<NOFILE> define on some systems,
-so you may have to set I<maxopen> yourself.
-
-=cut
-
-require 5.006;
-use Carp;
-use strict;
-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);
-$cacheout_maxopen = 16;
-
-use base 'Exporter';
-our @EXPORT = qw[cacheout cacheout_close];
-
-
-my %isopen;
-my $cacheout_seq = 0;
-
-sub import {
-    my ($pkg,%args) = @_;
-
-    # 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;
-
-    __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};
-
-    # XXX This code is crazy.  Why is it a one element foreach loop?
-    # Why is it using $param both as a filename and filehandle?
-    foreach my $param ( '/usr/include/sys/param.h' ){
-      if (open($param, '<', $param)) {
-	local ($_, $.);
-	while (<$param>) {
-	  if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
-	    $cacheout_maxopen = $1 - 4;
-	    close($param);
-	    last;
-	  }
-	}
-	close $param;
-      }
-    }
-    $cacheout_maxopen ||= 16;
-}
-
-# Open in their package.
-sub cacheout_open {
-  return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
-}
-
-# Close in their package.
-sub cacheout_close {
-  # Short-circuit in case the filehandle disappeared
-  my $pkg = caller($_[1]||0);
-  defined fileno(*{$pkg . '::' . $_[0]}) &&
-    CORE::close(*{$pkg . '::' . $_[0]});
-  delete $isopen{$_[0]};
-}
-
-# But only this sub name is visible to them.
-sub cacheout {
-    my($mode, $file, $class, $ret, $ref, $narg);
-    croak "Not enough arguments for cacheout"  unless $narg = scalar @_;
-    croak "Too many arguments for cacheout"    if $narg > 2;
-
-    ($mode, $file) = @_;
-    ($file, $mode) = ($mode, $file) if $narg == 1;
-    croak "Invalid mode for cacheout" if $mode &&
-      ( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
-
-    # Mode changed?
-    if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[1] ){
-      &cacheout_close($file, 1);
-    }
-
-    if( $isopen{$file}) {
-      $ret = $file;
-      $isopen{$file}->[0]++;
-    }
-    else{
-      if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
-	my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
-	$cacheout_seq = 0;
-	$isopen{$_}->[0] = $cacheout_seq++ for
-	  splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
-	&cacheout_close($_, 1) for @lru;
-      }
-
-      unless( $ref ){
-	$mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
-      }
-      #XXX should we just return the value from cacheout_open, no croak?
-      $ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
-
-      $isopen{$file} = [++$cacheout_seq, $mode];
-    }
-    return $ret;
-}
-1;
diff --git a/lib/FileCache/t/01open.t b/lib/FileCache/t/01open.t
deleted file mode 100644
index ee207ddf93..0000000000
--- a/lib/FileCache/t/01open.t
+++ /dev/null
@@ -1,35 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-use FileCache;
-use vars qw(@files);
-BEGIN {
-    @files = qw(foo bar baz quux Foo_Bar);
-    chdir 't' if -d 't';
-
-    #For tests within the perl distribution
-    @INC = '../lib' if -d '../lib';
-    END;
-}
-END{
-  1 while unlink @files;
-}
-
-
-print "1..1\n";
-
-{# Test 1: that we can open files
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 1\n";
-	 close $path;
-     }
-     print "not " unless scalar map({ -f } @files) == scalar @files;
-     print "ok 1\n";
-}
diff --git a/lib/FileCache/t/02maxopen.t b/lib/FileCache/t/02maxopen.t
deleted file mode 100644
index 2f737eb1c8..0000000000
--- a/lib/FileCache/t/02maxopen.t
+++ /dev/null
@@ -1,44 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-use FileCache maxopen=>2;
-use Test;
-use vars qw(@files);
-BEGIN {
-    @files = qw(foo bar baz quux);
-    chdir 't' if -d 't';
-
-    #For tests within the perl distribution
-    @INC = '../lib' if -d '../lib';
-    END;
-    plan tests=>5;
-}
-END{
-  1 while unlink @files;
-}
-
-{# Test 2: that we actually adhere to maxopen
-  for my $path ( @files ){
-    cacheout $path;
-    print $path "$path 1\n";
-  }
-  
-  my @cat;
-  for my $path ( @files ){
-    ok(fileno($path) || $path =~ /^(?:foo|bar)$/);
-    next unless fileno($path);
-    print $path "$path 2\n";
-    close($path);
-    open($path, $path);
-    <$path>;
-    push @cat, <$path>;
-    close($path);
-  }
-  ok( grep(/^(?:baz|quux) 2$/, @cat) == 2 );
-}
diff --git a/lib/FileCache/t/03append.t b/lib/FileCache/t/03append.t
deleted file mode 100644
index 5afc513eb6..0000000000
--- a/lib/FileCache/t/03append.t
+++ /dev/null
@@ -1,55 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-use FileCache maxopen=>2;
-use vars qw(@files);
-BEGIN {
-    @files = qw(foo bar baz quux Foo_Bar);
-    chdir 't' if -d 't';
-
-    #For tests within the perl distribution
-    @INC = '../lib' if -d '../lib';
-    END;
-}
-END{
-  1 while unlink @files;
-}
-
-print "1..2\n";
-
-{# Test 3: that we open for append on second viewing
-     my @cat;
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 3\n";
-     }
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 33\n";
-     }
-     for my $path ( @files ){
-	 open($path, '<', $path);
-	 push @cat, do{ local $/; <$path>};
-         close($path);
-     }
-     print 'not ' unless scalar grep(/\b3$/m, @cat) == scalar @files;
-     print "ok 1\n";
-     @cat = ();
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 333\n";
-     }
-     for my $path ( @files ){
-	 open($path, '<', $path);
-	 push @cat, do{ local $/; <$path>};
-         close($path);
-     }
-     print 'not ' unless scalar grep(/\b33$/m, @cat) == scalar @files;
-     print "ok 2\n";
-}
diff --git a/lib/FileCache/t/04twoarg.t b/lib/FileCache/t/04twoarg.t
deleted file mode 100644
index 40bae6dcbf..0000000000
--- a/lib/FileCache/t/04twoarg.t
+++ /dev/null
@@ -1,27 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-use FileCache;
-
-END{
-  unlink('foo');
-}
-
-print "1..1\n";
-
-{# Test 4: that 2 arg format works, and that we cycle on mode change
-     cacheout '>', "foo";
-     print foo "foo 4\n";
-     cacheout '+>', "foo";
-     print foo "foo 44\n";
-     seek(foo, 0, 0);
-     print 'not ' unless <foo> eq "foo 44\n";
-     print "ok 1\n";
-     close foo;
-}
diff --git a/lib/FileCache/t/05override.t b/lib/FileCache/t/05override.t
deleted file mode 100644
index b7b4083433..0000000000
--- a/lib/FileCache/t/05override.t
+++ /dev/null
@@ -1,23 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-use FileCache;
-
-END{
-  unlink("Foo_Bar");
-}
-print "1..1\n";
-
-{# Test 5: that close is overridden properly within the caller
-     cacheout local $_ = "Foo_Bar";
-     print $_ "Hello World\n";
-     close($_);
-     print 'not ' if fileno($_);
-     print "ok 1\n";
-}
diff --git a/lib/FileCache/t/06export.t b/lib/FileCache/t/06export.t
deleted file mode 100644
index 67d5996e74..0000000000
--- a/lib/FileCache/t/06export.t
+++ /dev/null
@@ -1,64 +0,0 @@
-#!./perl
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-BEGIN {
-    # 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"; 
-    }
-}
diff --git a/lib/FileCache/t/07noimport.t b/lib/FileCache/t/07noimport.t
deleted file mode 100644
index a6e024d002..0000000000
--- a/lib/FileCache/t/07noimport.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!./perl -w
-
-BEGIN {
-   if( $ENV{PERL_CORE} ) {
-        chdir 't' if -d 't';
-        @INC = qw(../lib);
-    }
-}
-
-require './test.pl';
-plan( tests => 1 );
-
-# Try using FileCache without importing to make sure everything's 
-# initialized without it.
-{
-    package Y;
-    use FileCache ();
-
-    my $file = 'foo';
-    END { unlink $file }
-    FileCache::cacheout($file);
-    print $file "bar";
-    close $file;
-
-    FileCache::cacheout("<", $file);
-    ::ok( <$file> eq "bar" );
-    close $file;
-}