r41180 - in /branches/upstream/libfile-readbackwards-perl/current: Changes MANIFEST META.yml Makefile.PL README ReadBackwards.pm t/ t/bw.t t/large_file.t
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Mon Aug 3 08:14:51 UTC 2009
Author: ryan52-guest
Date: Mon Aug 3 08:14:45 2009
New Revision: 41180
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41180
Log:
Load /tmp/tmp.lAzjhwyQBx/to_upload/File-ReadBackwards-1.04 into
branches/upstream/libfile-readbackwards-perl/current.
Added:
branches/upstream/libfile-readbackwards-perl/current/Changes
branches/upstream/libfile-readbackwards-perl/current/MANIFEST
branches/upstream/libfile-readbackwards-perl/current/META.yml
branches/upstream/libfile-readbackwards-perl/current/Makefile.PL
branches/upstream/libfile-readbackwards-perl/current/README
branches/upstream/libfile-readbackwards-perl/current/ReadBackwards.pm
branches/upstream/libfile-readbackwards-perl/current/t/
branches/upstream/libfile-readbackwards-perl/current/t/bw.t (with props)
branches/upstream/libfile-readbackwards-perl/current/t/large_file.t
Added: branches/upstream/libfile-readbackwards-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/Changes?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/Changes (added)
+++ branches/upstream/libfile-readbackwards-perl/current/Changes Mon Aug 3 08:14:45 2009
@@ -1,0 +1,89 @@
+Revision history for Perl extension File::ReadBackwards.
+
+0.90 Mon Feb 28 21:37:29 2000
+ - original version; created by h2xs 1.19
+
+0.91 fixed test suite
+
+0.92 edited documentation
+
+0.93 Tue Mar 7 23:31:40 EST 2000
+ removed use of qr// so it works under MacPerl
+ added README
+ edited documentation
+
+0.94 Wed Mar 8 00:12:28 EST 2000
+ removed use of for modifier so it works under MacPerl
+
+0.95 Fri Apr 26 13:48:40 EDT 2002
+ readline returns undef on a sysseek error so it fails cleanly on pipes
+ - from Carl Edwards <cedwards at vitesse.com>
+
+
+ added eof() method
+ - from Antti S Lankila <alankila at cc.helsinki.fi>
+
+ added flag to new() that marks the record separator as a regular
+ expression. that used to be the default behavior and now the
+ default is that is it a plain string like $/.
+ - from Robin Houston <robin at kitsite.com>
+
+ added close() method
+ - from kdamundson at mmm.com
+
+ updated pod to reflect the changes
+
+0.96 Sun May 26 00:28:49 EDT 2002
+
+ fixed bug in close method and added test for close
+ - from Robin Houston <robin at kitsite.com>
+
+0.97 Sun May 26 00:28:49 EDT 2002
+
+ D'oh! call CORE::close inside close(). robin had it correct
+ in his patch and i didn't use that.
+
+0.98 Wed Aug 21 22:51:41 EDT 2002
+
+ fixed bug with a partial buffer of '0'.
+ - from Joe Schaefer <joe+usenet at sunstarsys.com>
+
+0.99 Tue Dec 3 00:50:23 EST 2002
+
+ fixed bug where readline returns data after a close
+ - from Khamdy <xayaraj at speedfactory.net>
+
+1.00 Mon Aug 18 02:04:24 EDT 2003
+
+ fixed doc bug for the tied interface. the module name needs quotes
+ - from Madeleine Price <mad at ugcs.caltech.edu>
+
+ added support for the tell method (including tests)
+ - Slaven Rezic <srezic at iconmobile.net>
+
+1.01 Tue Oct 7 01:31:40 EDT 2003 (not released to cpan)
+
+ fixed bug in test script in close_test. the write_file fails on
+ winblows since the file is still open from the main loop. now the
+ file is closed explicitly and tests added to cover that.
+ - Peter J. Acklam <pjacklam at online.no>
+
+1.02 Fri Nov 21 01:53:42 EST 2003
+
+ fixed test problems with cr/lf files.
+ modified module to better handle them and when the rec_sep is set
+ all tests now work on unix and windows
+
+1.03 Mon Jan 24 17:57:54 EST 2005
+
+ added get_handle method and tests for it.
+ - Mark-Jason Dominus
+
+1.04 Thu May 5 01:10:44 EDT 2005
+
+ added getline method and tests for it
+ - Slaven Rezic <srezic at iconmobile.net>
+ added support and test for large files (>2GB)
+ - Slaven Rezic <srezic at iconmobile.net>
+
+
Added: branches/upstream/libfile-readbackwards-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/MANIFEST?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/MANIFEST (added)
+++ branches/upstream/libfile-readbackwards-perl/current/MANIFEST Mon Aug 3 08:14:45 2009
@@ -1,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+ReadBackwards.pm
+README
+t/bw.t
+t/large_file.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libfile-readbackwards-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/META.yml?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/META.yml (added)
+++ branches/upstream/libfile-readbackwards-perl/current/META.yml Mon Aug 3 08:14:45 2009
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: File-ReadBackwards
+version: 1.04
+version_from: ReadBackwards.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libfile-readbackwards-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/Makefile.PL?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/Makefile.PL (added)
+++ branches/upstream/libfile-readbackwards-perl/current/Makefile.PL Mon Aug 3 08:14:45 2009
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'File::ReadBackwards',
+ 'VERSION_FROM' => 'ReadBackwards.pm', # finds $VERSION
+);
Added: branches/upstream/libfile-readbackwards-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/README?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/README (added)
+++ branches/upstream/libfile-readbackwards-perl/current/README Mon Aug 3 08:14:45 2009
@@ -1,0 +1,55 @@
+
+ File::ReadBackwards.pm
+
+This module reads a file backwards line by line. It is simple to use,
+memory efficient and fast. It supports both an object and a tied handle
+interface.
+
+It is intended for processing log and other similar text files which
+typically have their newest entries appended to them. By default files
+are assumed to be plain text and have a line ending appropriate to the
+OS. But you can set the input record separator string on a per file
+basis.
+
+PREREQUISITES
+
+There are no prerequisite modules.
+
+INSTALLATION
+
+Installation is done as with most Perl modules by running these
+commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DOCUMENTATION
+
+Documentation is in the module file in pod form. It will be installed in
+the normal documentation directories on your system. An HTML version of
+the documentation is at:
+
+ http://www.sysarch.com/perl/modules/File-ReadBackwards.html
+
+SUPPORT
+
+If you have any questions, bug reports or feedback, email it to
+
+ uri at sysarch.com
+
+AVAILABILITY
+
+The latest version of File::ReadBackwards.pm will always be available in
+this directory:
+
+ http://www.sysarch.com/perl/modules
+
+
+COPYRIGHT
+
+(C) 2000 Uri Guttman. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
Added: branches/upstream/libfile-readbackwards-perl/current/ReadBackwards.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/ReadBackwards.pm?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/ReadBackwards.pm (added)
+++ branches/upstream/libfile-readbackwards-perl/current/ReadBackwards.pm Mon Aug 3 08:14:45 2009
@@ -1,0 +1,395 @@
+# File::ReadBackwards.pm
+
+# Copyright (C) 2003 by Uri Guttman. All rights reserved.
+# mail bugs, comments and feedback to uri at stemsystems.com
+
+package File::ReadBackwards ;
+
+use strict ;
+
+use vars qw( $VERSION ) ;
+
+$VERSION = '1.04' ;
+
+use Symbol ;
+use Fcntl qw( :seek O_RDONLY ) ;
+use Carp ;
+
+my $max_read_size = 1 << 13 ;
+
+my $default_rec_sep ;
+
+BEGIN {
+
+# set the default record separator according to this OS
+# this needs testing and expansion.
+
+# look for CR/LF types
+# then look for CR types
+# else it's a LF type
+
+ if ( $^O =~ /win32/i || $^O =~ /vms/i ) {
+
+ $default_rec_sep = "\015\012" ;
+ }
+ elsif ( $^O =~ /mac/i ) {
+
+ $default_rec_sep = "\015" ;
+ }
+ else {
+ $default_rec_sep = "\012" ;
+ }
+
+# the tied interface is exactly the same as the object one, so all we
+# need to do is to alias the subs with typeglobs
+
+ *TIEHANDLE = \&new ;
+ *READLINE = \&readline ;
+ *EOF = \&eof ;
+ *CLOSE = \&close ;
+ *TELL = \&tell ;
+
+# added getline alias for compatibility with IO::Handle
+
+ *getline = \&readline ;
+}
+
+
+# constructor for File::ReadBackwards
+
+sub new {
+
+ my( $class, $filename, $rec_sep, $sep_is_regex ) = @_ ;
+
+# check that we have a filename
+
+ defined( $filename ) || return ;
+
+# see if this file uses the default of a cr/lf separator
+# those files will get cr/lf converted to \n
+
+ $rec_sep ||= $default_rec_sep ;
+ my $is_crlf = $rec_sep eq "\015\012" ;
+
+# get a handle and open the file
+
+ my $handle = gensym ;
+ sysopen( $handle, $filename, O_RDONLY ) || return ;
+ binmode $handle ;
+
+# seek to the end of the file and get its size
+
+ my $seek_pos = sysseek( $handle, 0, SEEK_END ) or return ;
+
+# get the size of the first block to read,
+# either a trailing partial one (the % size) or full sized one (max read size)
+
+ my $read_size = $seek_pos % $max_read_size || $max_read_size ;
+
+# create the object
+
+ my $self = bless {
+ 'file_name' => $filename,
+ 'handle' => $handle,
+ 'read_size' => $read_size,
+ 'seek_pos' => $seek_pos,
+ 'lines' => [],
+ 'is_crlf' => $is_crlf,
+ 'rec_sep' => $rec_sep,
+ 'sep_is_regex' => $sep_is_regex,
+
+ }, $class ;
+
+ return( $self ) ;
+}
+
+# read the previous record from the file
+#
+sub readline {
+
+ my( $self, $line_ref ) = @_ ;
+
+ my $read_buf ;
+
+# get the buffer of lines
+
+ my $lines_ref = $self->{'lines'} ;
+
+ return unless $lines_ref ;
+
+ while( 1 ) {
+
+# see if there is more than 1 line in the buffer
+
+ if ( @{$lines_ref} > 1 ) {
+
+# we have a complete line so return it
+# and convert those damned cr/lf lines to \n
+
+ $lines_ref->[-1] =~ s/\015\012/\n/
+ if $self->{'is_crlf'} ;
+
+ return( pop @{$lines_ref} ) ;
+ }
+
+# we don't have a complete, so have to read blocks until we do
+
+ my $seek_pos = $self->{'seek_pos'} ;
+
+# see if we are at the beginning of the file
+
+ if ( $seek_pos == 0 ) {
+
+# the last read never made more lines, so return the last line in the buffer
+# if no lines left then undef will be returned
+# and convert those damned cr/lf lines to \n
+
+ $lines_ref->[-1] =~ s/\015\012/\n/
+ if @{$lines_ref} && $self->{'is_crlf'} ;
+
+ return( pop @{$lines_ref} ) ;
+ }
+
+# we have to read more text so get the handle and the current read size
+
+ my $handle = $self->{'handle'} ;
+ my $read_size = $self->{'read_size'} ;
+
+# after the first read, always read the maximum size
+
+ $self->{'read_size'} = $max_read_size ;
+
+# seek to the beginning of this block and save the new seek position
+
+ $seek_pos -= $read_size ;
+ sysseek( $handle, $seek_pos, SEEK_SET ) ;
+ $self->{'seek_pos'} = $seek_pos ;
+
+# read in the next (previous) block of text
+
+ my $read_cnt = sysread( $handle, $read_buf, $read_size ) ;
+
+# prepend the read buffer to the leftover (possibly partial) line
+
+ my $text = $read_buf ;
+ $text .= shift @{$lines_ref} if @{$lines_ref} ;
+
+# split the buffer into a list of lines
+# this may want to be $/ but reading files backwards assumes plain text and
+# newline separators
+
+ @{$lines_ref} = ( $self->{'sep_is_regex'} ) ?
+ $text =~ /(.*?$self->{'rec_sep'}|.+)/gs :
+ $text =~ /(.*?\Q$self->{'rec_sep'}\E|.+)/gs ;
+
+#print "Lines \n=>", join( "<=\n=>", @{$lines_ref} ), "<=\n" ;
+
+ }
+}
+
+sub eof {
+
+ my ( $self ) = @_ ;
+
+ my $seek_pos = $self->{'seek_pos'} ;
+ my $lines_count = @{ $self->{'lines'} } ;
+ return( $seek_pos == 0 && $lines_count == 0 ) ;
+}
+
+sub tell {
+ my ( $self ) = @_ ;
+
+ my $seek_pos = $self->{'seek_pos'} ;
+ $seek_pos + length(join "", @{ $self->{'lines'} });
+}
+
+sub get_handle {
+ my ( $self ) = @_ ;
+
+ my $handle = $self->{handle} ;
+ seek( $handle, $self->tell, SEEK_SET ) ;
+ return $handle ;
+}
+
+sub close {
+
+ my ( $self ) = @_ ;
+
+ my $handle = delete( $self->{'handle'} ) ;
+ delete( $self->{'lines'} ) ;
+
+ CORE::close( $handle ) ;
+}
+
+__END__
+
+
+=head1 NAME
+
+File::ReadBackwards.pm -- Read a file backwards by lines.
+
+
+=head1 SYNOPSIS
+
+ use File::ReadBackwards ;
+
+ # Object interface
+
+ $bw = File::ReadBackwards->new( 'log_file' ) or
+ die "can't read 'log_file' $!" ;
+
+ while( defined( $log_line = $bw->readline ) ) {
+ print $log_line ;
+ }
+
+ # ... or the alternative way of reading
+
+ until ( $bw->eof ) {
+ print $bw->readline ;
+ }
+
+ # Tied Handle Interface
+
+ tie *BW, 'File::ReadBackwards', 'log_file' or
+ die "can't read 'log_file' $!" ;
+
+ while( <BW> ) {
+ print ;
+ }
+
+=head1 DESCRIPTION
+
+
+This module reads a file backwards line by line. It is simple to use,
+memory efficient and fast. It supports both an object and a tied handle
+interface.
+
+It is intended for processing log and other similar text files which
+typically have their newest entries appended to them. By default files
+are assumed to be plain text and have a line ending appropriate to the
+OS. But you can set the input record separator string on a per file
+basis.
+
+
+=head1 OBJECT INTERFACE
+
+These are the methods in C<File::ReadBackwards>' object interface:
+
+
+=head2 new( $file, [$rec_sep], [$sep_is_regex] )
+
+C<new> takes as arguments a filename, an optional record separator and
+an optional flag that marks the record separator as a regular
+expression. It either returns the object on a successful open or undef
+upon failure. $! is set to the error code if any.
+
+=head2 readline
+
+C<readline> takes no arguments and it returns the previous line in the
+file or undef when there are no more lines in the file. If the file is
+a non-seekable file (e.g. a pipe), then undef is returned.
+
+=head2 getline
+
+C<getline> is an alias for the readline method. It is here for
+compatibilty with the IO::* classes which has a getline method.
+
+=head2 eof
+
+C<eof> takes no arguments and it returns true when readline() has
+iterated through the whole file.
+
+=head2 close
+
+C<close> takes no arguments and it closes the handle
+
+=head2 tell
+
+C<tell> takes no arguments and it returns the current filehandle position.
+This value may be used to seek() back to this position using a normal
+file handle.
+
+=head2 get_handle
+
+C<get_handle> takes no arguments and it returns the internal Perl
+filehandle used by the File::ReadBackwards object. This handle may be
+used to read the file forward. Its seek position will be set to the
+position that is returned by the tell() method. Note that
+interleaving forward and reverse reads may produce unpredictable
+results. The only use supported at present is to read a file backward
+to a certain point, then use 'handle' to extract the handle, and read
+forward from that point.
+
+=head1 TIED HANDLE INTERFACE
+
+=head2 tie( *HANDLE, 'File::ReadBackwards', $file, [$rec_sep], [$sep_is_regex] )
+
+
+The TIEHANDLE, READLINE, EOF, CLOSE and TELL methods are aliased to
+the new, readline, eof, close and tell methods respectively so refer
+to them for their arguments and API. Once you have tied a handle to
+File::ReadBackwards the only I/O operation permissible is <> which
+will read the previous line. You can call eof() and close() on the
+tied handle as well. All other tied handle operations will generate an
+unknown method error. Do not seek, write or perform any other
+unsupported operations on the tied handle.
+
+=head1 LINE AND RECORD ENDINGS
+
+
+Since this module needs to use low level I/O for efficiency, it can't
+portably seek and do block I/O without managing line ending conversions.
+This module supports the default record separators of normal line ending
+strings used by the OS. You can also set the separator on a per file
+basis.
+
+The record separator is a regular expression by default, which differs
+from the behavior of $/.
+
+Only if the record separator is B<not> specified and it defaults to
+CR/LF (e.g, VMS, redmondware) will it will be converted to a single
+newline. Unix and MacOS files systems use only a single character for
+line endings and the lines are left unchanged. This means that for
+native text files, you should be able to process their lines backwards
+without any problems with line endings. If you specify a record
+separator, no conversions will be done and you will get the records as
+if you read them in binary mode.
+
+=head1 DESIGN
+
+It works by reading a large (8kb) block of data from the end of the
+file. It then splits them on the record separator and stores a list of
+records in the object. Each call to readline returns the top record of
+the list and if the list is empty it refills it by reading the previous
+block from the file and splitting it. When the beginning of the file is
+reached and there are no more lines, undef is returned. All boundary
+conditions are handled correctly i.e. if there is a trailing partial
+line (no newline) it will be the first line returned and lines larger
+than the read buffer size are handled properly.
+
+
+=head1 NOTES
+
+
+There is no support for list context in either the object or tied
+interfaces. If you want to slurp all of the lines into an array in
+backwards order (and you don't care about memory usage) just do:
+
+ @back_lines = reverse <FH>.
+
+This module is only intended to read one line at a time from the end of
+a file to the beginning.
+
+=head1 AUTHOR
+
+
+Uri Guttman, uri at stemsystems.com
+
+=head1 COPYRIGHT
+
+
+Copyright (C) 2003 by Uri Guttman. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
Added: branches/upstream/libfile-readbackwards-perl/current/t/bw.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/t/bw.t?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/t/bw.t (added)
+++ branches/upstream/libfile-readbackwards-perl/current/t/bw.t Mon Aug 3 08:14:45 2009
@@ -1,0 +1,286 @@
+#!/usr/local/bin/perl -ws
+
+use strict ;
+use Test::More ;
+use Fcntl qw( :seek ) ;
+use File::ReadBackwards ;
+use Carp ;
+
+use vars qw( $opt_v ) ;
+
+my $file = 'bw.data' ;
+
+my $is_crlf = ( $^O =~ /win32/i || $^O =~ /vms/i ) ;
+
+print "nl\n" ;
+my @nl_data = init_data( "\n" ) ;
+plan( tests => 10 * @nl_data + 1 ) ;
+test_read_backwards( \@nl_data ) ;
+
+print "crlf\n" ;
+my @crlf_data = init_data( "\015\012" ) ;
+test_read_backwards( \@crlf_data, "\015\012" ) ;
+
+test_close() ;
+unlink $file ;
+
+exit ;
+
+sub init_data {
+
+ my ( $rec_sep ) = @_ ;
+
+ return map { ( my $data = $_ ) =~ s/RS/$rec_sep/g ; $data }
+ '',
+ 'RS',
+ 'RSRS',
+ 'RSRSRS',
+ "\015",
+ "\015RSRS",
+ 'abcd',
+ "abcdefghijRS",
+ "abcdefghijRS" x 512,
+ 'a' x (8 * 1024),
+ 'a' x (8 * 1024) . '0',
+ '0' x (8 * 1024) . '0',
+ 'a' x (32 * 1024),
+ join( 'RS', '00' .. '99', '' ),
+ join( 'RS', '00' .. '99' ),
+ join( 'RS', '0000' .. '9999', '' ),
+ join( 'RS', '0000' .. '9999' ),
+ ;
+}
+
+sub test_read_backwards {
+
+ my( $data_list_ref, $rec_sep ) = @_ ;
+
+ foreach my $data ( @$data_list_ref ) {
+
+# write the test data to a file in text or bin_mode
+
+ if ( defined $rec_sep ) {
+
+ write_bin_file( $file, $data ) ;
+
+# print "cnt: ${\scalar @rev_file_lines}\n" ;
+
+ }
+ else {
+ write_file( $file, $data ) ;
+
+ }
+
+ test_data( $rec_sep ) ;
+
+ test_tell_handle( $rec_sep ) ;
+ }
+}
+
+sub test_data {
+
+ my( $rec_sep ) = @_ ;
+
+# slurp in the file and reverse the list of lines to get golden data
+
+ my @rev_file_lines = reverse read_bin_file( $file ) ;
+
+# convert CR/LF to \n if needed - based on OS or we are testing CR/LF
+
+ if ( $is_crlf || $rec_sep && $rec_sep eq "\015\012" ) {
+ s/\015\012\z/\n/ for @rev_file_lines ;
+ }
+
+# open the file with backwards and read in the lines
+
+ my $bw = File::ReadBackwards->new( $file, $rec_sep ) or
+ die "can't open $file: $!" ;
+
+ my( @bw_file_lines ) ;
+ while ( 1 ) {
+
+ my $line = $bw->readline() ;
+ last unless defined( $line ) ;
+ push( @bw_file_lines, $line ) ;
+
+ $line = $bw->getline() ;
+ last unless defined( $line ) ;
+ push( @bw_file_lines, $line ) ;
+ }
+
+# while ( defined( my $line = $bw->readline() ) ) {
+# push( @bw_file_lines, $line) ;
+# }
+
+# see if we close cleanly
+
+ ok( $bw->close(), 'close' ) ;
+
+# compare the golden lines to the backwards lines
+
+ if ( eq_array( \@rev_file_lines, \@bw_file_lines ) ) {
+
+ ok( 1, 'read' ) ;
+ return ;
+ }
+
+# test failed so dump the different lines if verbose
+
+ ok( 0, 'read' ) ;
+
+ return unless $opt_v ;
+
+ print "[$rev_file_lines[0]]\n" ;
+ print unpack( 'H*', $rev_file_lines[0] ), "\n" ;
+ print unpack( 'H*', $bw_file_lines[0] ), "\n" ;
+
+#print "REV ", unpack( 'H*', join '', at rev_file_lines ), "\n" ;
+#print "BW ", unpack( 'H*', join '', at bw_file_lines ), "\n" ;
+
+}
+
+sub test_tell_handle {
+
+ my( $rec_sep ) = @_ ;
+
+# open the file backwards again to test tell and get_handle methods
+
+ my $bw = File::ReadBackwards->new( $file, $rec_sep ) or
+ die "can't open $file: $!" ;
+
+# read the last line in
+
+ my $bw_line = $bw->readline() ;
+
+# get the current seek position
+
+ my $pos = $bw->tell() ;
+
+#print "BW pos = $pos\n" ;
+
+ if ( $bw->eof() ) {
+
+ ok( 1, "skip tell - at eof" ) ;
+ ok( 1, "skip get_handle - at eof" ) ;
+ }
+ else {
+
+# save the current $/ so we can reassign it if it $rec_sep isn't set
+
+ my $old_rec_sep = $/ ;
+ local $/ = $rec_sep || $old_rec_sep ;
+
+# open a new regular file and seek to this spot.
+
+ open FH, $file or die "tell open $!" ;
+ seek FH, $pos, SEEK_SET or die "tell seek $!" ;
+
+# read in the next line and clean up the ending CR/LF
+
+ my $fw_line = <FH> ;
+ $fw_line =~ s/\015\012\z/\n/ ;
+
+# print "BW [", unpack( 'H*', $bw_line ),
+# "] TELL [", unpack( 'H*', $fw_line), "]\n" if $bw_line ne $fw_line ;
+
+# compare the backwards and forwards lines
+
+ is ( $bw_line, $fw_line, "tell check" ) ;
+
+# get the handle and seek to the current spot
+
+ my $fh = $bw->get_handle() ;
+
+# read in the next line and clean up the ending CR/LF
+
+ my $fh_line = <$fh> ;
+ $fh_line =~ s/\015\012\z/\n/ ;
+
+# print "BW [", unpack( 'H*', $bw_line ),
+# "] HANDLE [", unpack( 'H*', $fh_line), "]\n" if $bw_line ne $fh_line ;
+
+# compare the backwards and forwards lines
+
+ is ( $bw_line, $fh_line, "get_handle" ) ;
+ }
+
+ ok( $bw->close(), 'close2' ) ;
+
+}
+
+sub test_close {
+
+ write_file( $file, <<BW ) ;
+line1
+line2
+BW
+
+ my $bw = File::ReadBackwards->new( $file ) or
+ die "can't open $file: $!" ;
+
+ my $line = $bw->readline() ;
+
+ $bw->close() ;
+
+ if ( $bw->readline() ) {
+
+ ok( 0, 'close' ) ;
+ return ;
+ }
+
+ ok( 1, 'close' ) ;
+}
+
+sub read_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, $file_name ) || carp "can't open $file_name $!" ;
+
+ local( $/ ) unless wantarray ;
+
+ <FH>
+}
+
+# utility sub to write a file. takes a file name and a list of strings
+
+sub write_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+sub read_bin_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+ open( FH, $file_name ) || carp "can't open $file_name $!" ;
+ binmode( FH ) ;
+
+ local( $/ ) = shift if @_ ;
+
+ local( $/ ) unless wantarray ;
+
+ <FH>
+}
+
+# utility sub to write a file. takes a file name and a list of strings
+
+sub write_bin_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+ binmode( FH ) ;
+
+ print FH @_ ;
+}
Propchange: branches/upstream/libfile-readbackwards-perl/current/t/bw.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libfile-readbackwards-perl/current/t/large_file.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-readbackwards-perl/current/t/large_file.t?rev=41180&op=file
==============================================================================
--- branches/upstream/libfile-readbackwards-perl/current/t/large_file.t (added)
+++ branches/upstream/libfile-readbackwards-perl/current/t/large_file.t Mon Aug 3 08:14:45 2009
@@ -1,0 +1,107 @@
+#!/usr/local/bin/perl -ws
+
+use strict ;
+
+use Carp ;
+use Config ;
+use Fcntl qw( :seek ) ;
+use Test::More ;
+
+use File::ReadBackwards ;
+
+# NOTE: much of this code was taken from the core perl test script
+# ops/lfs.t. it was modified to test File::ReadBackwards and large files
+
+my %has_no_sparse_files = map { $_ => 1 }
+ qw( MSWin32 NetWare VMS unicos ) ;
+
+my $test_file = 'bw.data' ;
+
+my @test_lines = (
+ "3rd from last line\n",
+ "2nd from last\n",
+ "last line\n",
+) ;
+
+my $test_text = join '', @test_lines ;
+
+
+sub skip_all_tests {
+
+ my( $skip_text ) = @_ ;
+
+# unlink $test_file ;
+ plan skip_all => $skip_text ;
+}
+
+if( $Config{lseeksize} < 8 ) {
+ skip_all_tests( "no 64-bit file offsets\n" ) ;
+}
+
+unless( $Config{uselargefiles} ) {
+ skip_all_tests( "no large file support\n" ) ;
+}
+
+if ( $has_no_sparse_files{ $^O } ) {
+ skip_all_tests( "no sparse files in $^O\n" ) ;
+}
+
+# run the long seek code below in a subprocess in case it exits with a
+# signal
+
+my $rc = system $^X, '-e', <<"EOF";
+open(BIG, ">$test_file");
+seek(BIG, 5_000_000_000, 0);
+print BIG "$test_text" ;
+exit 0;
+EOF
+
+if( $rc ) {
+
+ my $error = 'signal ' . ($rc & 0x7f) ;
+ skip_all_tests( "seeking past 2GB failed: $error" ) ;
+}
+
+open(BIG, ">$test_file");
+
+unless( seek(BIG, 5_000_000_000, 0) ) {
+ skip_all_tests( "seeking past 2GB failed: $!" ) ;
+}
+
+
+# Either the print or (more likely, thanks to buffering) the close will
+# fail if there are are filesize limitations (process or fs).
+
+my $print = print BIG $test_text ;
+my $close = close BIG;
+
+unless ($print && $close) {
+
+ print "# print failed: $!\n" unless $print;
+ print "# close failed: $!\n" unless $close;
+
+ if( $! =~/too large/i ) {
+ skip_all_tests( 'writing past 2GB failed: process limits?' ) ;
+ }
+
+ if( $! =~ /quota/i ) {
+ skip_all_tests( 'filesystem quota limits?' ) ;
+ }
+
+ skip_all_tests( "large file error: $!" ) ;
+}
+
+plan tests => 2 ;
+
+my $bw = File::ReadBackwards->new( $test_file ) or
+ die "can't open $test_file: $!" ;
+
+my $line = $bw->readline() ;
+is( $line, $test_lines[-1], 'last line' ) ;
+
+$line = $bw->readline() ;
+is( $line, $test_lines[-2], 'next to last line' ) ;
+
+unlink $test_file ;
+
+exit ;
More information about the Pkg-perl-cvs-commits
mailing list