FileIndex.pm

package FileIndex;

use vars qw($AUTOLOAD @ISA);
use Exporter;
use Carp;
use strict;
use FileHandle;

@ISA = qw(Exporter);

my $suffix = ".FileIndex";

my %fields = (
	      filename => undef,
	      verbose => undef,
	      filehandle => undef,
	      index => undef
);

sub new {
    my $obj = shift;
    my $filename = shift;
    my $verbose = @_ ? shift : 1;
    my $separator = @_ ? shift : $/;

    my $pkg = ref($obj) || $obj;
    my $self = { _permitted=>\%fields, %fields };
    bless $self, $pkg;

    $self->filename($filename);
    $self->verbose($verbose);

    $self->filehandle(new FileHandle);
    $self->filehandle->open("< $filename") or confess ref($self).": couldn't open $filename for reading: $!";
    $self->filehandle->input_record_separator($separator);

    $self->buildindex($filename);
    $self;
}

sub DESTROY {
    my ($self) = @_;
    $self->filehandle->close;
}

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self) || confess "AUTOLOAD: object unknown: $self";
    my $name = $AUTOLOAD;

    # don't propagate DESTROY messages...

    $name =~ /::DESTROY/ && return;

    $name =~ s/.*://; # get only the bit we want
    unless (exists $self->{'_permitted'}->{$name} ) { confess "$type: can't access $name" }

    if (@_) { return $self->{$name} = shift }
    else { return $self->{$name} }
}

sub buildindex {
    my ($self,$filename) = @_;
    unless (-r $filename) { confess ref($self).": can't read $filename" }
    my $indexfilename = "$filename$suffix";
    my @fstat;
    my @istat;
    local *INDEX;
    if (-e $indexfilename and @fstat=stat($filename), @istat=stat($indexfilename), $istat[9] > $fstat[9]) {
	my $indexdata;
	open INDEX, $indexfilename or confess ref($self).": couldn't open $indexfilename for reading: $!";
	read INDEX, $indexdata, $istat[7];
	close INDEX;
	$self->index([unpack("I*",$indexdata)]);
    } else {
	carp ref($self).": building index for $filename" if $self->verbose;
	my ($n,$fpos,@index);
	$n = $fpos = 0;
	while ($fpos = $self->filehandle->tell, $_ = $self->filehandle->getline) { push @index, $fpos }
	open INDEX, ">$indexfilename" or confess ref($self).": couldn't open $indexfilename for writing: $!";
	print INDEX pack("I*",@index);
	close INDEX;
	$self->index(\@index);
    }
}

# data access methods

sub lines {
    my ($self) = @_;
    scalar(@{$self->index});
}

sub getline {
    my ($self,@n) = @_;
    my @result;
    my $index = $self->index;
    my $n;
    foreach $n (@n) {
	if ($n < 0 || $n >= @$index) {
	    carp ref($self).": tried to access line $n of ".$self->filename." (only ".$self->lines." lines long)" if $self->verbose;
	    push @result, undef;
	} else {
	    $self->filehandle->seek($index->[$n],0);
	    push @result, $self->filehandle->getline;
	}
    }
    @n==1 ? shift(@result) : @result;    # return scalar if possible
}


1;