## -*- Perl -*-# nmzidx.pl - subroutines for accessing Namazu index files (NMZ.*)#         by furukawa@tcp-ip.or.jp## $Id: nmzidx.pl,v 1.13 2001/01/10 16:59:45 furukawa Exp $##  This program is free software; you can redistribute it and/or modify#  it under the terms of the GNU General Public License as published by#  the Free Software Foundation; either versions 2, or (at your option)#  any later version.# #  This program is distributed in the hope that it will be useful#  but WITHOUT ANY WARRANTY; without even the implied warranty of#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the#  GNU General Public License for more details.##  You should have received a copy of the GNU General Public License#  along with this program; if not, write to the Free Software#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA#  02111-1307, USA#use strict;use IO::File;use DirHandle;package nmzlib;sub open_db{    my $par = shift;    my $ext = shift;    my $path = $par->{'dir'} . "/NMZ.$ext";    my $fh;    if ($par->{'mode'} =~ /w/i){        $fh = new IO::File "$path.$$.tmp", "w";    }else{        $fh = new IO::File $path, "r";    }    $par->{'dblist'}->{$path} = $fh, binmode $fh if defined $fh;    return $fh;}sub readw{    my $fh = shift;    my $ret = '';    my $c;    while (read($fh, $c, 1)){        $ret .= $c;        last unless 0x80 & ord $c;    }    unpack('w', $ret);}package nmzfile;sub new{    my $class = shift;    my $self = {};    bless $self, $class;    my $par = shift;    my $ext = shift;    my $fhb = &nmzlib::open_db($par, $ext);    $self->{'dir'} = $par->{'dir'};    $self->{'mode'} = $par->{'mode'};    $self->{'body'} = $fhb if defined $fhb;    $self->{'ext'} = $ext;    $ext .= ($ext =~ /^field/)? '.i': 'i';    my $fhi = &nmzlib::open_db($par, $ext);    $self->{'index'} = $fhi if defined $fhi;    $self->{'offset'} = 0;    if (defined($self->{'index'})){        $self->{'size'} = (-s $self->{'index'}) / length(pack('N', 0));    }    return $self;}sub close{    my $self = shift;    $self->{'body'}->close;    $self->{'index'}->close if defined $self->{'index'};}sub seek{    my $self = shift;    my $offset = @_? shift: 0;    my $whence = @_? shift: 0;    if ($whence == 1){        $offset += $self->{'offset'};    }elsif ($whence == 2){        $offset += $self->{'size'};    }    return $offset if $offset == $self->{'offset'};    return -1 if ($offset < 0 || $offset > $self->{'size'});    $self->{'offset'} = $offset;    $self->{'index'}->seek($offset * length(pack('N', 0)), 0);    if ($self->{'ext'} ne 'p'){        if ($offset == $self->{'size'}){            $self->{'body'}->seek(0, 2);        }else{            my $buf;            $self->{'index'}->read($buf, length pack('N', 0));            $self->{'body'}->seek(unpack('N', $buf), 0);        }    }    return $offset;}sub getline{    my $self = shift;    return undef unless defined $self->{'body'};    ++$self->{'offset'};    return $self->{'body'}->getline;}sub getlist{    my $self = shift;    return undef unless defined $self->{'body'};    return undef if $self->{'offset'} >= $self->{'size'};    if ($self->{'offset'} == $self->{'size'}){        return ();    }    ++$self->{'offset'};    if ($self->{'ext'} eq 'p'){        my $buf;        $self->{'index'}->read($buf, length pack('N', 0));        return () if $buf eq pack('N', -1);        $self->{'body'}->seek(unpack('N', $buf), 0);    }    $self->{'body'}->read(my $buf, &nmzlib::readw($self->{'body'}));    return unpack('w*', $buf);}sub putline{    my $self = shift;    if (@_){        $self->{'index'}->print(pack('N', $self->{'body'}->tell));        $self->{'body'}->print(shift);        ++$self->{'size'};        ++$self->{'offset'};    }}sub putlist{    my $self = shift;    if (@_){        $self->{'index'}->print(pack('N', $self->{'body'}->tell));        my $tmp = pack('w*', @_);        $self->{'body'}->print(pack('w', length $tmp) . $tmp);    }elsif ($self->{'ext'} eq 'p'){        $self->{'index'}->print(pack('N', -1));        ++$self->{'size'};        ++$self->{'offset'};    }}package nmzfield;sub new{    my $class = shift;    my $self = {};    bless $self, $class;    $self->open(@_) if @_;    return $self;}sub open{    my $self = shift;    my $par = shift;    my $ext = shift;    $self->{$ext} = new nmzfile($par, "field." . $ext);}sub open_all{    my $self = shift;    my $par = shift;    my $dh = new DirHandle($par->{'dir'});    while (defined(my $ent = $dh->read)){        if ($ent =~ /^NMZ\.field\.([^\.]+)$/){            $self->{$1} = new nmzfile($par, "field." . $1);        }    }    $dh->close;}sub close{    my $self = shift;    for my $key (keys %$self){        $self->{$key}->close;    }}sub seek{    my $self = shift;    $self->seek(@_);}package nmzflist;sub new{    my $class = shift;    my $self = {};    my $par = shift;    bless $self, $class;    $self->{'dir'} = $par->{'dir'};    $self->{'mode'} = $par->{'mode'};    $self->{'t'} = &nmzlib::open_db($par, 't');    $self->{'r'} = &nmzlib::open_db($par, 'r') unless $par->{'mode'} =~ /s/i;    $self->{'field'} = new nmzfield;    $self->{'field'}->open_all($par);    $self->{'offset'} = 0;    $self->{'size'} = (-s $self->{'t'}) / length(pack('N', 0));    $self->{'valid'} = $self->{'size'};    return $self;}sub close{    my $self = shift;    $self->{'t'}->close;    $self->{'r'}->close if defined $self->{'r'};    $self->{'field'}->close;}sub read{    my $self = shift;    my $list = shift;    %$list = ();    my $fh = $self->{'t'};    $fh->read(my $pindex, length pack('N', 0));    $list->{'t'} = ($pindex eq pack('N', -1))? -1: unpack('N', $pindex);    if (defined(my $fh = $self->{'r'})){        $list->{'r'} = $fh->getline;        $list->{'r'} = $fh->getline while (defined($list->{'r'}) && $list->{'r'} =~ /^[\#\r\n]/);        chomp $list->{'r'} if defined $list->{'r'};    }    my $field = $self->{'field'};    for my $key (keys %$field){        $fh = $field->{$key};        my $line = $fh->getline;        $line = '' unless defined $line;        chomp $line;        $list->{'field'}->{$key} = $line;    }    --$self->{'valid'} if defined($list->{'t'}) && $list->{'t'} == -1;    ++$self->{'offset'};    return $list->{'t'}}sub write{    my $self = shift;    my $list = shift;    my $fh = $self->{'t'};    $fh->print(pack('N', $list->{'t'}));    $fh = $self->{'r'};    $fh->print($list->{'r'} . "\n");    my $field = $self->{'field'};    for my $key (keys %$field){        $field->{$key}->putline($list->{'field'}->{$key} . "\n")    }    ++$self->{'valid'} if $list->{'t'} != -1;    ++$self->{'size'};    ++$self->{'offset'};}sub seek{    my $self = shift;    my $offset = @_? shift: 0;    my $whence = @_? shift: 0;    $self->{'t'}->seek($offset * length pack('N', 0), $whence);    my $field = $self->{'field'};    for my $key (keys %$field){        $field->{$key}->seek($offset, $whence);    }    if ($whence == 0){        $self->{'offset'} = $offset;    }elsif ($whence == 1){        $self->{'offset'} += $offset;    }elsif ($whence == 2){        $self->{'offset'} = $offset + $self->{'size'};    }    return $self->{'offset'};}package nmzword;sub new{    my $class = shift;    my $par = shift;    my $self = {};    bless $self, $class;    $self->{'dir'} = $par->{'dir'};    $self->{'mode'} = $par->{'mode'};    $self->{'i'} = new nmzfile($par, 'i');    $self->{'w'} = new nmzfile($par, 'w');    $self->{'offset'} = 0;    $self->{'size'} = $self->{'i'}->{'size'};    return $self;}sub close{    my $self = shift;    $self->{'i'}->close;    $self->{'w'}->close;}sub read{    my $self = shift;    my $word = shift;    my $list = shift;    %$list = ();    return unless defined($$word = $self->{'w'}->getline);    chomp $$word;    my $key = 0;    my @tmp = $self->{'i'}->getlist;    $key += shift @tmp, $list->{$key} = shift @tmp while @tmp;    ++$self->{'offset'};    return $$word;}sub write{    my $self = shift;    my $word = shift;    my $list = shift;    if (length $word and scalar keys %$list){        $self->{'w'}->putline($word . "\n");        my @tmp = ();        my $ndx = 0;        for my $key (sort {$a <=> $b} keys %$list){            push(@tmp, $key - $ndx);