# -*- mode: Perl -*-
#

package DB_Namazu_Field;
use Carp;
use strict;
use IO::File;
use Tie::Array;
our @ISA = ('Tie::Array');

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless($self, $class);
    return $self;
}

sub TIEARRAY {
    my $class = shift;
    my $basefile = shift;
    my $self = $class->new();
    $self->{basefile} = new IO::File " <$basefile";
    $self->{ptrfile} = new IO::File "< ${basefile}.i";
    croak "can't open $basefile" unless ($self->{basefile});
    croak "can't open ${basefile}.i" unless ($self->{ptrfile});
    bless($self, $class);
    return $self;
}

sub FETCH {
    my $self = shift;
    my $index = shift;
    $self->{ptrfile}->seek($index, SEEK_SET);
    my $ptr;
    $self->{ptrfile}->read($ptr, 4);
    $ptr = unpack("N", $ptr);
    $self->{basefile}->seek($ptr, SEEK_SET);
    return $self->{basefile}->getline;
}

sub STORE {
    my $self = shift;
    my ($index, $value) = @_;
    croak "this module don't support update yet.";
}

sub FETCHSIZE {
    my $self = shift;
    my @stat = $self->{ptrfile}->stat;
    return $stat[7] / 4 - 1; # size
}

sub STORESIZE {
    my $self = shift;
    my $count = shift;
    croak "this module don't support update yet.";
}

sub EXTEND {
    my $self = shift;
    my $count = shift;
    croak "this module don't support update yet.";
}

sub EXISTS {
    my $self = shift;
    my $key = shift;
    return 0 if $self->FETCHSIZE() > $key;
    return 1;
}

sub DELETE {
    my $self = shift;
    my $index = shift;
    croak "this module don't support update yet.";
}

sub CLEAR {
    my $self = shift;
    croak "this module don't support update yet.";
}

sub PUSH {
    my $self = shift;
    my @list = @_;
    croak "this module don't support update yet.";
}

sub POP {
    my $self = shift;
    croak "this module don't support update yet.";
}

sub SHIFT {
    my $self = shift;
    croak "this module don't support update yet.";
}

sub UNSHIFT {
    my $self = shift;
    my @list = @_;
    croak "this module don't support update yet.";
}

sub SPLICE {
    my $self = shift;
    croak "this module don't support update yet.";
}

sub DESTROY {
    my $self = shift;
    $self->{basefile}->close;
    $self->{ptrfile}->close;
    undef $self->{basefile};
    undef $self->{ptrfile};
}

1;