t/bw.t

   1 #!/usr/local/bin/perl -ws
   2
   3 use strict ;
   4 use Test::More ;
   5 use Fcntl qw( :seek ) ;
   6 use File::ReadBackwards ;
   7 use Carp ;
   8
   9 use vars qw( $opt_v ) ;
  10
  11 my $file = 'bw.data' ;
  12
  13 my $is_crlf = ( $^O =~ /win32/i || $^O =~ /vms/i ) ;
  14
  15 print "nl\n" ;
  16 my @nl_data = init_data( "\n" ) ;
  17 plan( tests => 10 * @nl_data + 1 ) ;
  18 test_read_backwards( \@nl_data ) ;
  19
  20 print "crlf\n" ;
  21 my @crlf_data = init_data( "\015\012" ) ;
  22 test_read_backwards( \@crlf_data, "\015\012" ) ;
  23
  24 test_close() ;
  25 unlink $file ;
  26
  27 exit ;
  28
  29 sub init_data {
  30
  31         my ( $rec_sep ) = @_ ;
  32
  33         return map { ( my $data = $_ ) =~ s/RS/$rec_sep/g ; $data }
  34                         '',
  35                         'RS',
  36                         'RSRS',
  37                         'RSRSRS',
  38                         "\015",
  39                         "\015RSRS",
  40                         'abcd',
  41                         "abcdefghijRS",
  42                         "abcdefghijRS" x 512,
  43                         'a' x (8 * 1024),
  44                         'a' x (8 * 1024) . '0',
  45                         '0' x (8 * 1024) . '0',
  46                         'a' x (32 * 1024),
  47                         join( 'RS', '00' .. '99', '' ),
  48                         join( 'RS', '00' .. '99' ),
  49                         join( 'RS', '0000' .. '9999', '' ),
  50                         join( 'RS', '0000' .. '9999' ),
  51         ;
  52 }
  53
  54 sub test_read_backwards {
  55
  56         my( $data_list_ref, $rec_sep ) = @_ ;
  57
  58         foreach my $data ( @$data_list_ref ) {
  59
  60 # write the test data to a file in text or bin_mode
  61
  62                 if ( defined $rec_sep ) {
  63
  64                         write_bin_file( $file, $data ) ;
  65
  66 # print "cnt: ${\scalar @rev_file_lines}\n" ;
  67
  68                 }
  69                 else {
  70                         write_file( $file, $data ) ;
  71
  72                 }
  73
  74                 test_data( $rec_sep ) ;
  75
  76                 test_tell_handle( $rec_sep ) ;
  77         }
  78 }
  79
  80 sub test_data {
  81
  82         my( $rec_sep ) = @_ ;
  83
  84 # slurp in the file and reverse the list of lines to get golden data
  85
  86         my @rev_file_lines = reverse read_bin_file( $file ) ;
  87
  88 # convert CR/LF to \n if needed - based on OS or we are testing CR/LF
  89
  90         if ( $is_crlf || $rec_sep && $rec_sep eq "\015\012" ) {
  91                 s/\015\012\z/\n/ for @rev_file_lines ;
  92         }
  93
  94 # open the file with backwards and read in the lines
  95
  96         my $bw = File::ReadBackwards->new( $file, $rec_sep ) or
  97                                 die "can't open $file: $!" ;
  98
  99         my( @bw_file_lines ) ;
 100         while ( 1 ) {
 101
 102                 my $line = $bw->readline() ;
 103                 last unless defined( $line ) ;
 104                 push( @bw_file_lines, $line ) ;
 105
 106                 $line = $bw->getline() ;
 107                 last unless defined( $line ) ;
 108                 push( @bw_file_lines, $line ) ;
 109         }
 110
 111 #       while ( defined( my $line = $bw->readline() ) ) {
 112 #               push( @bw_file_lines, $line) ;
 113 #       }
 114
 115 # see if we close cleanly
 116
 117         ok( $bw->close(), 'close' ) ;
 118
 119 # compare the golden lines to the backwards lines
 120
 121         if ( eq_array( \@rev_file_lines, \@bw_file_lines ) ) {
 122
 123                 ok( 1, 'read' ) ;
 124                 return ;
 125         }
 126
 127 # test failed so dump the different lines if verbose
 128
 129         ok( 0, 'read' ) ;
 130
 131         return unless $opt_v ;
 132
 133         print "[$rev_file_lines[0]]\n" ;
 134         print unpack( 'H*', $rev_file_lines[0] ), "\n" ;
 135         print unpack( 'H*', $bw_file_lines[0] ), "\n" ;
 136
 137 #print "REV ", unpack( 'H*', join '',@rev_file_lines ), "\n" ;
 138 #print "BW  ", unpack( 'H*', join '',@bw_file_lines ), "\n" ;
 139
 140 }
 141
 142 sub test_tell_handle {
 143
 144         my( $rec_sep ) = @_ ;
 145
 146 # open the file backwards again to test tell and get_handle methods
 147
 148         my $bw = File::ReadBackwards->new( $file, $rec_sep ) or
 149                                 die "can't open $file: $!" ;
 150
 151 # read the last line in
 152
 153         my $bw_line = $bw->readline() ;
 154
 155 # get the current seek position
 156
 157         my $pos = $bw->tell() ;
 158
 159 #print "BW pos = $pos\n" ;
 160
 161         if ( $bw->eof() ) {
 162
 163                 ok( 1, "skip tell - at eof" ) ;
 164                 ok( 1, "skip get_handle - at eof" ) ;
 165         }
 166         else {
 167
 168 # save the current $/ so we can reassign it if it $rec_sep isn't set
 169
 170                 my $old_rec_sep = $/ ;
 171                 local $/ = $rec_sep || $old_rec_sep ;
 172
 173 # open a new regular file and seek to this spot.
 174
 175                 open FH, $file or die "tell open $!" ;
 176                 seek FH, $pos, SEEK_SET or die "tell seek $!" ;
 177
 178 # read in the next line and clean up the ending CR/LF
 179
 180                 my $fw_line = <FH> ;
 181                 $fw_line =~ s/\015\012\z/\n/ ;
 182
 183 # print "BW [", unpack( 'H*', $bw_line ),
 184 # "] TELL [", unpack( 'H*', $fw_line), "]\n" if $bw_line ne $fw_line ;
 185
 186 # compare the backwards and forwards lines
 187
 188                 is ( $bw_line, $fw_line, "tell check" ) ;
 189
 190 # get the handle and seek to the current spot
 191
 192                 my $fh = $bw->get_handle() ;
 193
 194 # read in the next line and clean up the ending CR/LF
 195
 196                 my $fh_line = <$fh> ;
 197                 $fh_line =~ s/\015\012\z/\n/ ;
 198
 199 # print "BW [", unpack( 'H*', $bw_line ),
 200 # "] HANDLE [", unpack( 'H*', $fh_line), "]\n" if $bw_line ne $fh_line ;
 201
 202 # compare the backwards and forwards lines
 203
 204                 is ( $bw_line, $fh_line, "get_handle" ) ;
 205         }
 206
 207         ok( $bw->close(), 'close2' ) ;
 208
 209 }
 210
 211 sub test_close {
 212
 213         write_file( $file, <<BW ) ;
 214 line1
 215 line2
 216 BW
 217
 218         my $bw = File::ReadBackwards->new( $file ) or
 219                                         die "can't open $file: $!" ;
 220
 221         my $line = $bw->readline() ;
 222
 223         $bw->close() ;
 224
 225         if ( $bw->readline() ) {
 226
 227                 ok( 0, 'close' ) ;
 228                 return ;
 229         }
 230
 231         ok( 1, 'close' ) ;
 232 }
 233
 234 sub read_file {
 235
 236         my( $file_name ) = shift ;
 237
 238         local( *FH ) ;
 239
 240         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 241
 242         local( $/ ) unless wantarray ;
 243
 244         <FH>
 245 }
 246
 247 # utility sub to write a file. takes a file name and a list of strings
 248
 249 sub write_file {
 250
 251         my( $file_name ) = shift ;
 252
 253         local( *FH ) ;
 254
 255         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 256
 257         print FH @_ ;
 258 }
 259
 260 sub read_bin_file {
 261
 262         my( $file_name ) = shift ;
 263
 264         local( *FH ) ;
 265         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 266         binmode( FH ) ;
 267
 268         local( $/ ) = shift if @_ ;
 269
 270         local( $/ ) unless wantarray ;
 271
 272         <FH>
 273 }
 274
 275 # utility sub to write a file. takes a file name and a list of strings
 276
 277 sub write_bin_file {
 278
 279         my( $file_name ) = shift ;
 280
 281         local( *FH ) ;
 282         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 283         binmode( FH ) ;
 284
 285         print FH @_ ;
 286 }