dist/Tie-File/t/18_rs_fixrec.t

   1 #!/usr/bin/perl
   2
   3 use POSIX 'SEEK_SET';
   4 my $file = "tf$$.txt";
   5 $/ = "blah";
   6
   7 print "1..5\n";
   8
   9 my $N = 1;
  10 use Tie::File;
  11 print "ok $N\n"; $N++;
  12
  13 my $o = tie @a, 'Tie::File', $file, autodefer => 0;
  14 print $o ? "ok $N\n" : "not ok $N\n";
  15 $N++;
  16
  17 $a[0] = 'rec0';
  18 check_contents("rec0blah");
  19 $a[1] = "rec1blah";
  20 check_contents("rec0blahrec1blah");
  21 $a[2] = "rec2blahblah";             # should we detect this?
  22 check_contents("rec0blahrec1blahrec2blahblah");
  23
  24 sub check_contents {
  25   my $x = shift;
  26   local *FH = $o->{fh};
  27   seek FH, 0, SEEK_SET;
  28   my $a;
  29   { local $/; $a = <FH> }
  30   $a = "" unless defined $a;
  31   if ($a eq $x) {
  32     print "ok $N\n";
  33   } else {
  34     my $msg = "not ok $N # expected <$x>, got <$a>";
  35     ctrlfix($msg);
  36     print "$msg\n";
  37   }
  38   $N++;
  39 }
  40
  41 sub ctrlfix {
  42   for (@_) {
  43     s/\n/\\n/g;
  44     s/\r/\\r/g;
  45   }
  46 }
  47
  48 END {
  49   undef $o;
  50   untie @a;
  51   1 while unlink $file;
  52 }
  53