package File::Index; use strict; use warnings; use Carp; use Readonly; use Config; Readonly my $CONFIG_LONG_SIZE => $Config{longsize}; sub new { my( $class, $data_filename, $options ) = @_; my $self = {}; bless $self, $class; $options = defined( $options ) ? $options : {}; $self->{data_filename} = $data_filename; $self->{idx_filename} = exists( $options->{idx_file} ) ? $options->{idx_file} : $data_filename . '.idx'; $self->{record_sep} = exists( $options->{record_sep} ) ? $options->{record_sep} : "\n"; $self->{data_binmode} = exists( $options->{data_binmode} ) ? $options->{data_binmode} : 0; if( not -f $self->{idx_filename} ) { $self->create_index_file(); } return $self; } sub create_index_file { my( $self ) = @_; open my $datafile_handle, '<', $self->{data_filename} or croak $!; if( $self->{data_binmode} ) { binmode $datafile_handle; } open my $index_handle , '>', $self->{idx_filename} or croak $!; local $/ = $self->{record_sep}; binmode( $index_handle ); print $index_handle pack( 'L', 0 ) or croak $!; while( <$datafile_handle> ) { my $entry = pack 'L', tell(); print $index_handle $entry or croak $!; } close $datafile_handle; close $index_handle or croak $!; } sub get_index { my( $self, $item_no ) = @_; open my $index_handle, '<', $self->{idx_filename} or croak $!; binmode( $index_handle ); local $\ = \$CONFIG_LONG_SIZE; seek( $index_handle, $item_no * $CONFIG_LONG_SIZE, 0 ) or croak $!; defined( my $packed_index = <$index_handle>) or croak "No record for item number $item_no\n"; my $unpacked_index = unpack( 'L', $packed_index ); return $unpacked_index; } 1; package main; use strict; use warnings; use Readonly; # Uncomment the next line if File::Index is not in the # same script file as the main program. # use File::Index; # Initialize some filenames. Readonly my $BIG_FILENAME => 'bigfile.tmp' ; Readonly my $INDEX_FILENAME => $BIG_FILENAME . '.idx'; # If we already have a "big file" don't bother creating a new one. unless( -f $BIG_FILENAME ) { make_big_file( $BIG_FILENAME, 10000 ); } # Initialize an index object based on newlines for the record # separator. my $idx_newline = File::Index->new( $BIG_FILENAME, { index_filename => $INDEX_FILENAME, record_sep => "\n" } ); print "Choose a record number (blank entry exits).\n"; while( <> ) { chomp; last unless m/^\d+$/; print "\tIndex for record $_: ", my $index = $idx_newline->get_index( $_ ), "\n"; open my $infile, '<', $BIG_FILENAME or die $!; seek( $infile, $index, 0 ) or die $!; defined( my $line = <$infile> ) or die "Line $_ doesn't exist!\n"; print "\t$line\n"; } # ----- Helper subs for demonstration purposes. ----- # Creates a file of N lines length, where each line is of random # width (from 0 through 78), and filled with random # printable characters. sub make_big_file { my( $filename, $lines ) = @_; open my $bigfile, '>', $filename or die $!; foreach( 0 .. $lines ) { my $line = generate_line( 0, 78 ); print $bigfile $line; } close $bigfile or die $!; } # Generates a line of random printable characters. sub generate_line { my( $min_length, $max_length ) = @_; $max_length++; # Make the range "inclusive". my $line_length = int( rand( $max_length - $min_length ) ) + $min_length; my $line = ''; # Zero length is possible. $line .= generate_char() foreach 1 .. $line_length; $line .= "\n"; return $line; } # Generate a single random printable character. sub generate_char { # Range is limited to printable, from ASCII space # through ASCII 'z'. return chr( int( rand( 90 ) ) + 32 ); }