lib/Tie/File/t/13_size_rs.t

   1 #!/usr/bin/perl
   2 #
   3 # Check FETCHSIZE and SETSIZE functions
   4 # PUSH POP SHIFT UNSHIFT
   5 #
   6
   7 use POSIX 'SEEK_SET';
   8
   9 my $file = "tf$$.txt";
  10 my $data = "rec0blahrec1blahrec2blah";
  11 my ($o, $n);
  12
  13 print "1..10\n";
  14
  15 my $N = 1;
  16 use Tie::File;
  17 print "ok $N\n"; $N++;
  18
  19 # 2-3 FETCHSIZE 0-length file
  20 open F, "> $file" or die $!;
  21 close F;
  22 $o = tie @a, 'Tie::File', $file, recsep => 'blah';
  23 print $o ? "ok $N\n" : "not ok $N\n";
  24 $N++;
  25 $n = @a;
  26 print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  27 $N++;
  28
  29 # Reset everything
  30 undef $o;
  31 untie @a;
  32
  33 # 4-5 FETCHSIZE positive-length file
  34 open F, "> $file" or die $!;
  35 print F $data;
  36 close F;
  37 $o = tie @a, 'Tie::File', $file, recsep => 'blah';
  38 print $o ? "ok $N\n" : "not ok $N\n";
  39 $N++;
  40 $n = @a;
  41 print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  42 $N++;
  43
  44 # STORESIZE
  45 # 6 Make it longer:
  46 $#a = 4;
  47 check_contents("${data}blahblah");
  48
  49 # 7 Make it longer again:
  50 $#a = 6;
  51 check_contents("${data}blahblahblahblah");
  52
  53 # 8 Make it shorter:
  54 $#a = 4;
  55 check_contents("${data}blahblah");
  56
  57 # 9 Make it shorter again:
  58 $#a = 2;
  59 check_contents($data);
  60
  61 # 10 Get rid of it completely:
  62 $#a = -1;
  63 check_contents('');
  64
  65
  66 sub check_contents {
  67   my $x = shift;
  68   local *FH = $o->{fh};
  69   seek FH, 0, SEEK_SET;
  70   my $a;
  71   { local $/; $a = <FH> }
  72   $a = "" unless defined $a;
  73   if ($a eq $x) {
  74     print "ok $N\n";
  75   } else {
  76     ctrlfix(my $msg = "# expected <$x>, got <$a>");
  77     print "not ok $N\n$msg\n";
  78   }
  79   $N++;
  80 }
  81
  82
  83 sub ctrlfix {
  84   for (@_) {
  85     s/\n/\\n/g;
  86     s/\r/\\r/g;
  87   }
  88 }
  89
  90 END {
  91   undef $o;
  92   untie @a;
  93   1 while unlink $file;
  94 }
  95