/[wait]/trunk/lib/WAIT/InvertedIndex.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WAIT/InvertedIndex.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

cvs-head/lib/WAIT/InvertedIndex.pm revision 80 by ulpfr, Sat Apr 20 15:01:38 2002 UTC trunk/lib/WAIT/InvertedIndex.pm revision 88 by dpavlin, Mon May 24 13:44:01 2004 UTC
# Line 4  Line 4 
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
5  # Created On      : Thu Aug  8 13:05:10 1996  # Created On      : Thu Aug  8 13:05:10 1996
6  # Last Modified By: Ulrich Pfeifer  # Last Modified By: Ulrich Pfeifer
7  # Last Modified On: Sat Apr 20 16:56:29 2002  # Last Modified On: Sat Apr 27 16:13:55 2002
8  # Language        : CPerl  # Language        : CPerl
9  #  #
10  # (C) Copyright 1996-2002, Ulrich Pfeifer  # (C) Copyright 1996-2002, Ulrich Pfeifer
# Line 12  Line 12 
12    
13  package WAIT::InvertedIndex;  package WAIT::InvertedIndex;
14  use strict;  use strict;
15  use DB_File;  use BerkeleyDB;
16  use Fcntl;  use Fcntl;
17  use WAIT::Filter;  use WAIT::Filter;
18  use Carp;  use Carp;
# Line 156  sub is_an_old_index { Line 156  sub is_an_old_index {
156    
157    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
158    $self->sync;    $self->sync;
159    my $dbh = $self->{dbh};       # for convenience    my $dbh = $self->{dbh} or return $self->{old_index} = 0;       # for convenience
160    
161    my $O = pack('C', 0xff)."o";    my $O = pack('C', 0xff)."o";
162    my ($word, $value) = ($O.$;);  # $word and $value are modified by seq!    my ($word, $value) = ($O.$;);  # $word and $value are modified by seq!
163    if ( my $ret = $dbh->seq($word, $value, R_CURSOR) ) {    if ( my $ret = $dbh->seq($word, $value, DB_CURSOR) ) {
164      # warn "DEBUG: ret[$ret], not an old index, either empty or no \$^O";      # warn "DEBUG: ret[$ret], not an old index, either empty or no \$^O";
165      return $self->{old_index} = 0;      return $self->{old_index} = 0;
166    }    }
# Line 169  sub is_an_old_index { Line 169  sub is_an_old_index {
169        # warn "DEBUG: word[$word]value[$value], not an old index";        # warn "DEBUG: word[$word]value[$value], not an old index";
170        return $self->{old_index} = 0;        return $self->{old_index} = 0;
171      }      }
172      if (my $ret = $dbh->seq($word, $value, R_NEXT) or # no values left      if (my $ret = $dbh->seq($word, $value, DB_NEXT) or # no values left
173          $word !~ /^$O$;/o                   # no $O values left          $word !~ /^$O$;/o                   # no $O values left
174         ) {         ) {
175        # we are not sure enough that this is an old index        # we are not sure enough that this is an old index
# Line 190  sub open { Line 190  sub open {
190    } else {    } else {
191      $self->{func}     =      $self->{func}     =
192        eval sprintf("sub {grep /./, %s}", _filtergen(@{$self->{filter}}));        eval sprintf("sub {grep /./, %s}", _filtergen(@{$self->{filter}}));
193      $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,      $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
194                         $self->{mode}, 0664, $DB_BTREE);                         -Filename => $self->{file},
195                           -Subname  => $self->{name},
196                           -Mode     => $self->{mode};
197      $self->{cache} = {}      $self->{cache} = {}
198        if $self->{mode} & O_RDWR;        if $self->{mode} & O_RDWR;
199      $self->{cdict} = {}      $self->{cdict} = {}
# Line 328  sub intervall { Line 330  sub intervall {
330    $last  = (defined $last)?'p'.$last:'q';    $last  = (defined $last)?'p'.$last:'q';
331    
332    # set the cursor to $first    # set the cursor to $first
333    $dbh->seq($first, $value, R_CURSOR);    $dbh->seq($first, $value, DB_CURSOR);
334    
335    # $first would be after the last word    # $first would be after the last word
336    return () if $first gt $last;    return () if $first gt $last;
337        
338    push @result, substr($first,1);    push @result, substr($first,1);
339    while (!$dbh->seq($word, $value, R_NEXT)) {    while (!$dbh->seq($word, $value, DB_NEXT)) {
340      # We should limit this to a "resonable" number of words      # We should limit this to a "resonable" number of words
341      last if $word gt $last;      last if $word gt $last;
342      push @result, substr($word,1);      push @result, substr($word,1);
# Line 362  sub prefix { Line 364  sub prefix {
364      ($prefix) = &{$self->{'pfunc'}}($prefix);      ($prefix) = &{$self->{'pfunc'}}($prefix);
365    }    }
366    
367    if ($dbh->seq($word = 'p'.$prefix, $value, R_CURSOR)) {    if ($dbh->seq($word = 'p'.$prefix, $value, DB_CURRENT)) {
368      return ();      return ();
369    }    }
370    return () if $word !~ /^p$prefix/;    return () if $word !~ /^p$prefix/;
371    push @result, substr($word,1);    push @result, substr($word,1);
372    
373    while (!$dbh->seq($word, $value, R_NEXT)) {    while (!$dbh->seq($word, $value, DB_NEXT)) {
374      # We should limit this to a "resonable" number of words      # We should limit this to a "resonable" number of words
375      last if $word !~ /^p$prefix/;      last if $word !~ /^p$prefix/;
376      push @result, substr($word,1);      push @result, substr($word,1);
# Line 669  sub search_raw { Line 671  sub search_raw {
671  sub set {  sub set {
672    my ($self, $attr, $value) = @_;    my ($self, $attr, $value) = @_;
673    
674    die "No such indexy attribute: '$attr'" unless $attr eq 'top';    die "No such index attribute: '$attr'" unless $attr eq 'top';
675    
676    return delete $self->{reorg} if $value == 0;    return delete $self->{reorg} if $value == 0;
677    
Legend:
Removed from v.80  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26