/[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

revision 88 by dpavlin, Mon May 24 13:44:01 2004 UTC revision 89 by dpavlin, Mon May 24 20:57:08 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 27 16:13:55 2002  # Last Modified On: Mon Apr 22 16:52:01 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 BerkeleyDB;  use DB_File;
16  use Fcntl;  use Fcntl;
17  use WAIT::Filter;  use WAIT::Filter;
18  use Carp;  use Carp;
# Line 160  sub is_an_old_index { Line 160  sub is_an_old_index {
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, DB_CURSOR) ) {    if ( my $ret = $dbh->seq($word, $value, R_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, DB_NEXT) or # no values left      if (my $ret = $dbh->seq($word, $value, R_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}}, 'BerkeleyDB::Btree',      $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,
194                         -Filename => $self->{file},                         $self->{mode}, 0664, $DB_BTREE);
                        -Subname  => $self->{name},  
                        -Mode     => $self->{mode};  
195      $self->{cache} = {}      $self->{cache} = {}
196        if $self->{mode} & O_RDWR;        if $self->{mode} & O_RDWR;
197      $self->{cdict} = {}      $self->{cdict} = {}
# Line 330  sub intervall { Line 328  sub intervall {
328    $last  = (defined $last)?'p'.$last:'q';    $last  = (defined $last)?'p'.$last:'q';
329    
330    # set the cursor to $first    # set the cursor to $first
331    $dbh->seq($first, $value, DB_CURSOR);    $dbh->seq($first, $value, R_CURSOR);
332    
333    # $first would be after the last word    # $first would be after the last word
334    return () if $first gt $last;    return () if $first gt $last;
335        
336    push @result, substr($first,1);    push @result, substr($first,1);
337    while (!$dbh->seq($word, $value, DB_NEXT)) {    while (!$dbh->seq($word, $value, R_NEXT)) {
338      # We should limit this to a "resonable" number of words      # We should limit this to a "resonable" number of words
339      last if $word gt $last;      last if $word gt $last;
340      push @result, substr($word,1);      push @result, substr($word,1);
# Line 364  sub prefix { Line 362  sub prefix {
362      ($prefix) = &{$self->{'pfunc'}}($prefix);      ($prefix) = &{$self->{'pfunc'}}($prefix);
363    }    }
364    
365    if ($dbh->seq($word = 'p'.$prefix, $value, DB_CURRENT)) {    if ($dbh->seq($word = 'p'.$prefix, $value, R_CURSOR)) {
366      return ();      return ();
367    }    }
368    return () if $word !~ /^p$prefix/;    return () if $word !~ /^p$prefix/;
369    push @result, substr($word,1);    push @result, substr($word,1);
370    
371    while (!$dbh->seq($word, $value, DB_NEXT)) {    while (!$dbh->seq($word, $value, R_NEXT)) {
372      # We should limit this to a "resonable" number of words      # We should limit this to a "resonable" number of words
373      last if $word !~ /^p$prefix/;      last if $word !~ /^p$prefix/;
374      push @result, substr($word,1);      push @result, substr($word,1);
Legend:
Removed from v.88  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26