dist/Tie-File/t/08_ro.t

   1 #!/usr/bin/perl
   2 #
   3 # Make sure it works to open the file in read-only mode
   4 #
   5
   6 my $file = "tf$$.txt";
   7 $: = Tie::File::_default_recsep();
   8
   9 print "1..13\n";
  10
  11 my $N = 1;
  12 use Tie::File;
  13 use Fcntl 'O_RDONLY';
  14 print "ok $N\n"; $N++;
  15
  16 my @items = qw(Gold Frankincense Myrrh Ivory Apes Peacocks);
  17 init_file(join $:, @items, '');
  18
  19 my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0;
  20 print $o ? "ok $N\n" : "not ok $N\n";
  21 $N++;
  22
  23 $#a == $#items ? print "ok $N\n" : print "not ok $N\n";
  24 $N++;
  25
  26 for my $i (0..$#items) {
  27   ("$items[$i]$:" eq $a[$i]) ? print "ok $N\n" : print "not ok $N\n";
  28   $N++;
  29 }
  30
  31 sub init_file {
  32   my $data = shift;
  33   open F, "> $file" or die $!;
  34   binmode F;
  35   print F $data;
  36   close F;
  37 }
  38
  39 undef $o; untie @a;
  40 my $badrec = "Malformed";
  41 # (10-13) When a record lacks the record seprator, we sneakily try
  42 # to fix it.  How does that work when the file is read-only?
  43 if (setup_badly_terminated_file(4)) {
  44   my $good = 1;
  45   my $warn;
  46   local $SIG{__WARN__} = sub { $good = 0; ctrlfix($warn = shift); };
  47   local $^W = 1;
  48   my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0
  49     or die "Couldn't tie $file: $!";
  50
  51   print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n";  $N++;
  52   print $good ? "ok $N\n" : "not ok $N # $warn\n";  $good = 1; $N++;
  53   print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n";  $N++;
  54   print $good ? "ok $N\n" : "not ok $N # $warn\n";  $good = 1; $N++;
  55 }
  56
  57 sub setup_badly_terminated_file {
  58   my $NTESTS = shift;
  59   open F, "> $file" or die "Couldn't open $file: $!";
  60   binmode F;
  61   print F $badrec;
  62   close F;
  63   unless (-s $file == length $badrec) {
  64     for (1 .. $NTESTS) {
  65       print "ok $N \# skipped - can't create improperly terminated file\n";
  66       $N++;
  67     }
  68     return;
  69   }
  70   return 1;
  71 }
  72
  73
  74 sub ctrlfix {
  75   for (@_) {
  76     s/\n/\\n/g;
  77     s/\r/\\r/g;
  78   }
  79 }
  80
  81 END {
  82   undef $o;
  83   untie @a;
  84   1 while unlink $file;
  85 }
  86