lib/FileCache.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 print "1..5\n";
   9
  10 use FileCache maxopen=>2;
  11 my @files = qw(foo bar baz quux);
  12
  13 {# Test 1: that we can open files
  14      for my $path ( @files ){
  15          cacheout $path;
  16          print $path "$path 1\n";
  17      }
  18      print "not " unless scalar map({ -f } @files) == 4;
  19      print "ok 1\n";
  20 }
  21
  22
  23 {# Test 2: that we actually adhere to maxopen
  24     my @cat;
  25     for my $path ( @files ){
  26         print $path "$path 2\n";
  27         close($path);
  28         open($path, $path);
  29         <$path>;
  30         push @cat, <$path>;
  31         close($path);
  32     }
  33     print "not " if (grep {/foo|bar/} @cat) && ! (grep {/baz|quux/} @cat);
  34     print "ok 2\n" ;
  35 }
  36
  37 {# Test 3: that we open for append on second viewing
  38      my @cat;
  39      for my $path ( @files ){
  40          cacheout $path;
  41          print $path "$path 3\n";
  42      }
  43      for my $path ( @files ){
  44          open($path, $path);
  45          push @cat, do{ local $/; <$path>};
  46          close($path);
  47      }
  48      print "not " unless scalar map({ /3$/ } @cat) == 4;
  49      print "ok 3\n";
  50 }
  51
  52
  53 {# Test 4: that 2 arg format works
  54      cacheout '+<', "foo";
  55      print foo "foo 2\n";
  56      close foo;
  57      cacheout '<', "foo";
  58      print "not " unless <foo> eq "foo 2\n";
  59      print "ok 4\n";
  60      close(foo);
  61 }
  62
  63 {# Test 5: that close is overridden properly
  64      cacheout local $_ = "Foo_Bar";
  65      print $_ "Hello World\n";
  66      close($_);
  67      open($_, "+>$_");
  68      print $_ "$_\n";
  69      seek($_, 0, 0);
  70      print "not " unless <$_> eq "$_\n";
  71      print "ok 5\n";
  72      close($_);
  73 }
  74
  75 q(
  76 {# Test close override
  77      package Bob;
  78      use FileCache;
  79      cacheout local $_ = "Foo_Bar";
  80      print $_ "Hello World\n";
  81      close($_);
  82      open($_, "+>$_");
  83      print $_ "$_\n";
  84      seek($_, 0, 0);
  85      print "not " unless <$_> eq "$_\n";
  86      print "ok 5\n";
  87      close($_);
  88 }
  89 );
  90
  91 1 while unlink @files, "Foo_Bar";