nmzidx.pl

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

            push(@tmp, $list->{$key});
            $ndx = $key;
        }
        $self->{'i'}->putlist(@tmp);
        ++$self->{'size'};
        ++$self->{'offset'};
    }
}

sub seek{
    my $self = shift;

    my $offset_i = $self->{'i'}->seek(@_);
    my $offset_w = $self->{'w'}->seek(@_);

    if ($offset_i == $offset_w){
        return $self->{'offset'} = $offset_i;
    }else{
        return -1;
    }
}

sub getword{
    my $self = shift;
    my $number = shift;
    $self->seek($number, 0);
    my $buf = $self->{'w'}->getline;
    chomp $buf;
    return $buf;
}

sub _search_{
    my $self = shift;
    my $keyword = shift;
    my $l = 0;
    my $r = $self->{'size'} - 1;
    my $ptr = (@_ && ref($_[0]) eq 'SCALAR')? shift: undef;
    $r = $$ptr if defined($ptr) && $$ptr >= 0;

    if (defined $self->{'cache'}->{'search'}->{$keyword}){
        $$ptr = $self->{'cache'}->{'search'}->{$keyword} if defined $ptr;
        return $self->{'cache'}->{'search'}->{$keyword};
    }

    my $x;
    while ($x = ($l + $r) >> 1, $l < $r){
        my $buf = $self->getword($x);
        if ($buf eq $keyword){
            $$ptr = $self->{'cache'}->{'search'}->{$keyword} = $x if defined $ptr;
            return $x;
        }
        if ($buf ge $keyword){
            $r = $x;
        }else{
            $l = $x + 1;
        }
    }
    $$ptr = $x if defined $ptr;
    return $self->{'cache'}->{'search'}->{$keyword} = -1;
}

sub wakati{
    my $self = shift;
    my $keyword = shift;
    my $opt = @_? shift: '';
    my $buf;

    my $r = -1;
    my $x;
    my $post = '';
    my $pat = ($opt =~ /b/)? '.': '..';
    while (1){
        $x = $self->_search_($keyword, \$r);
        last if $x >= 0 || $keyword !~ s/($pat)$//;
        $post = $1 . $post;
    }
    return ($keyword, $post);
}

sub forward{
    my $self = shift;
    my $word = shift;
    my $keyword = shift;
    my $buf;

    my $x = $self->_search_($keyword);

    $keyword = quotemeta($keyword);
    @$word = ();
    while (($buf = $self->getword($x)) =~ /^$keyword/){
        $self->{'cache'}->{'search'}->{$buf} = $x++;
        push(@$word, $buf);
    }
    return @$word;
}

sub search{
    my $self = shift;
    my $list = shift;
    my $keyword = shift;
    my $word;

    if ((my $x = $self->_search_($keyword)) >= 0){
        $self->seek($x, 0);
        return $self->read(\$word, $list);
    }else{
        return undef;
    }
}

package nmzphrase;
@nmzphrase::Seed = ();

sub new{
    my $class = shift;
    my $par = shift;
    my $self = {};
    bless $self, $class;

    $self->{'dir'} = $par->{'dir'};
    $self->{'mode'} = $par->{'mode'};

    $self->{'p'} = new nmzfile($par, 'p');
    $self->{'offset'} = 0;
    $self->{'size'} = 0x10000;
    $self->init_seed if $self->{'mode'} =~ /s/i;
    return $self;
}

sub close{
    my $self = shift;
    $self->{'p'}->close;
}

sub read{
    my $self = shift;
    my $list = shift;

    @$list = ();
    my $ndx = 0;
    my @tmp = $self->{'p'}->getlist;
    push(@$list, $ndx += shift @tmp) while @tmp;
    ++$self->{'offset'};
    return scalar @$list;
}

sub write{
    my $self = shift;
    my $list = shift;

    my $fh_p = $self->{'p'};
    my $fh_pi = $self->{'pi'};
    my @tmp = ();
    my $ndx = 0;

    for my $key (@$list){
        push(@tmp, $key - $ndx);
        $ndx = $key;
    }
    $self->{'p'}->putlist(@tmp);
    ++$self->{'offset'};
}

sub seek{
    my $self = shift;
    return $self->{'offset'} = $self->{'p'}->seek(@_);
}

sub search{
    my $self = shift;
    my $list = shift;
    my $phrase = shift;
    $phrase .= shift if @_;

    my $hash = 0;
    my $i = 0;
    while ($phrase =~ m/([\xa1-\xfea-z\d])/g){
        $hash ^= $nmzphrase::Seed[($i++) & 3][ord($1)];
    }
    $self->seek($hash & 0xffff);

    %$list = ();
    my @tmp = ();
    if ($self->read(\@tmp)){
        for my $x (@tmp){
            $list->{$x} = 1;
        }
    }
    return scalar @tmp;
}


sub init_seed{
    return if scalar @nmzphrase::Seed;
    require 'seed.pl';
    @nmzphrase::Seed = &seed::init;
}

package nmzidx;
sub new{
    my $class = shift;
    my $dir = @_? shift: '.';
    my $mode = @_? shift: 'r';

    if ($mode =~ /[RS]/){
        return undef if -f "$dir/NMZ.lock";
        if (defined(my $fh = new IO::File ">$dir/NMZ.lock2")){
            $fh->print($$);
            $fh->close;
        }
    }

    my $self = {};
    bless $self, $class;

    $self->{'dir'} = $dir;
    $self->{'mode'} = $mode;
    return $self;
}

sub close{
    my $self = shift;
    unlink ($self->{'dir'} . "/NMZ.lock2") if $self->{'mode'} =~ /[RS]/;
}

sub open_field{
    my $self = shift;

    $self->{'field'} = new nmzfield() unless $self->{'field'};
    $self->{'field'}->open($self, @_);
    return $self->{'field'};
}

sub open_flist{
    my $self = shift;
    $self->{'flist'} = new nmzflist($self);
    return $self->{'flist'};
}

sub open_word{
    my $self = shift;
    $self->{'word'} = new nmzword($self);
    return $self->{'word'};
}

sub open_phrase{
    my $self = shift;
    return $self->{'phrase'} = new nmzphrase($self);
}

sub replace_db{
    my $self = shift;
    my $bak = @_? shift : 0;
    my $lock = $self->{'dir'} . "/NMZ.lock";

    if ($self->{'mode'} =~ /W/){
        my $fh = new IO::File($lock, 'w');
        $fh->close;
    }

    for my $path (keys %{$self->{'dblist'}}){
        $self->{'dblist'}->{$path}->close;
        if ($bak){
            unlink "$path.BAK" if (-f $path) && (-f "$path.BAK");
            rename $path, "$path.BAK";
        }
        unlink $path if (-f "$path.$$.tmp") && (-f $path);
        rename "$path.$$.tmp", $path;
    }
    unlink $lock if $self->{'mode'} =~ /W/;
}

sub remove_tmpdb{
    my $self = shift;

    for my $path (keys %{$self->{'dblist'}}){
        $self->{'dblist'}->{$path}->close;
        unlink "$path.$$.tmp";
    }
}

sub write_status{
    my $self = shift;
    my $in = shift;

    my $key = undef;
    $key = $self->{'word'}->{'size'} if defined $self->{'word'};

    my $file = undef;
    $file = $self->{'flist'}->{'valid'} if defined $self->{'flist'};

    if ($self->{'mode'} =~ /w/i){
        my $fi = &nmzlib::open_db($in, 'status');
        my $fo = &nmzlib::open_db($self, 'status');
        while (defined(my $line = $fi->getline)){
            $line = "files $file\n" if $line =~ /^files / && defined $file;
            $line = "keys $key\n" if $line =~ /^keys / && defined $key;
            $fo->print($line);
        }
        $fi->close;
        $fo->close;
        my $dh = new DirHandle($in->{'dir'});
        while (defined(my $ent = $dh->read)){
	    next if $ent =~ /\.(BAK|tmp)$/;
	    if ($ent =~ /^NMZ\.(head(?:\.[-\w\.]+)?)$/){
                $fi = &nmzlib::open_db($in, $1);
                $fo = &nmzlib::open_db($self, $1);

                while (defined(my $line = $fi->getline)){
                    $line =~ s/(\<\!-- FILE --\>).*?\1/$1 $file $1/ if defined $file;
                    $line =~ s/(\<\!-- KEY --\>).*?\1/$1 $key $1/ if defined $key;
                    $fo->print($line);
                }
                $fi->close;
                $fo->close;
            }
        }
        undef $dh;
    }
}

sub log_open{
    my $self = shift;
    my $tag = shift;
    my $path = $self->{'dir'} . "/NMZ.log";
    my $fh = new IO::File ">>$path";
    $self->{'log'} = $fh;
    if (defined $fh){
        binmode $fh;
        $fh->print("$tag\n") if defined $tag;
        $self->log_putline("Date:",  localtime($^T) . "");
    }
    return $self->{'log'};
}

sub log_putline{
    my $self = shift;
    $self->{'log'}->printf("%-20s %s\n", @_);
}

sub log_close{
    my $self = shift;
    if (defined $self->{'log'}){
        $self->log_putline("Perl:", $]);
        $self->log_putline("System:", $^O);
        $self->log_putline("Time (sec):", (time - $^T));
        $self->{'log'}->print("\n");
        $self->{'log'}->close;
    }
}
1;