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 );
}
[download]