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 }
  61
  62 {# Test 5: that close is overridden properly
  63      cacheout local $_ = "Foo_Bar";
  64      print $_ "Hello World\n";
  65      close($_);
  66      open($_, "+>$_");
  67      print $_ "$_\n";
  68      seek($_, 0, 0);
  69      print "not " unless <$_> eq "$_\n";
  70      print "ok 5\n";
  71 }
  72
  73 q(
  74 {# Test close override
  75      package Bob;
  76      use FileCache;
  77      cacheout local $_ = "Foo_Bar";
  78      print $_ "Hello World\n";
  79      close($_);
  80      open($_, "+>$_");
  81      print $_ "$_\n";
  82      seek($_, 0, 0);
  83      print "not " unless <$_> eq "$_\n";
  84      print "ok 5\n";
  85 }
  86 );
  87
  88 1 while unlink @files, "Foo_Bar";