nmzidx.pl

namazu. 虽然是日语的,也适用于文件中单词索引后全文检索.

#
# -*- Perl -*-
# nmzidx.pl - subroutines for accessing Namazu index files (NMZ.*)
#         by [e-mail]
#
# $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);