/[wait]/trunk/lib/WAIT/Table.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/Table.pm

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

cvs-head/lib/WAIT/Table.pm revision 10 by ulpfr, Fri Apr 28 15:40:52 2000 UTC branches/CPAN/lib/WAIT/Table.pm revision 19 by ulpfr, Tue May 9 11:29:45 2000 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Perl -*-  #                              -*- Mode: Cperl -*-
2  # Table.pm --  # Table.pm --
3  # ITIID           : $ITI$ $Header $__Header$  # ITIID           : $ITI$ $Header $__Header$
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: Sun Nov 22 18:44:37 1998  # Last Modified On: Mon May  8 20:20:58 2000
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 51  # Update Count    : 131
10  # Status          : Unknown, Use with caution!  # Status          : Unknown, Use with caution!
11  #  #
12  # Copyright (c) 1996-1997, Ulrich Pfeifer  # Copyright (c) 1996-1997, Ulrich Pfeifer
13  #  #
14    
15  =head1 NAME  =head1 NAME
16    
# Line 25  WAIT::Table -- Module for maintaining Ta Line 25  WAIT::Table -- Module for maintaining Ta
25  =cut  =cut
26    
27  package WAIT::Table;  package WAIT::Table;
28    
29    use WAIT::Table::Handle ();
30  require WAIT::Parse::Base;  require WAIT::Parse::Base;
31    
32  use strict;  use strict;
33  use Carp;  use Carp;
34    # use autouse Carp => qw( croak($) );
35  use DB_File;  use DB_File;
36  use Fcntl;  use Fcntl;
37    use LockFile::Simple ();
38    
39  my $USE_RECNO = 0;  my $USE_RECNO = 0;
40    
41  =head2 Creating a Table.  =head2 Creating a Table.
42    
43  The constructor WAIT::Table-<gt>new is normally called via the  The constructor WAIT::Table-E<gt>new is normally called via the
44  create_table method of a database handle. This is not enforced, but  create_table method of a database handle. This is not enforced, but
45  creating a table doesn not make any sense unless the table is  creating a table does not make any sense unless the table is
46  registered by the database because the latter implements persistence  registered by the database because the latter implements persistence
47  of the meta data. Registering is done automatically by letting the  of the meta data. Registering is done automatically by letting the
48  database handle create a table.  database handle the creation of a table.
49    
50    my $db = create WAIT::Database name => 'sample';    my $db = WAIT::Database->create(name => 'sample');
51    my $tb = $db->create_table (name     => 'test',    my $tb = $db->create_table(name     => 'test',
52                                attr     => ['docid', 'headline'],                               access   => $access,
53                                layout   => $layout,                               layout   => $layout,
54                                access   => $access,                               attr     => ['docid', 'headline'],
55                               );                              );
56    
57  The constructor returns a handle for the table. This handle is hidden by the  The constructor returns a handle for the table. This handle is hidden by the
58  table module, to prevent direct access if called via Table.  table module, to prevent direct access if called via Table.
59    
60  =over 10  =over 10
61    
62  =item C<access> => I<accesobj>  =item C<access> => I<accessobj>
63    
64  A reference to a acces object for the external parts (attributes) of  A reference to an access object for the external parts (attributes) of
65  tuples. As you may remember, the WAIT System does not enforce that  tuples. As you may remember, the WAIT System does not enforce that
66  objects are completely stored inside the system to avoid duplication.  objects are completely stored inside the system to avoid duplication.
67  There is no (strong) point in storing all you HTML-Documents inside  There is no (strong) point in storing all your HTML documents inside
68  the system when indexing your WWW-Server.  the system when indexing your WWW-Server.
69    
70    The access object is designed to work like as a tied hash. You pass
71    the refernce to the object, not the tied hash though. An example
72    implementation of an access class that works for manpages is
73    WAIT::Document::Nroff.
74    
75    The implementation needs to take into account that WAIT will keep this
76    object in a Data::Dumper or Storable database and re-use it when sman
77    is run. So it is not good enough if we can produce the index with it
78    now, when we create or actively access the table, WAIT also must be
79    able to retrieve documents on its own, when we are in a different
80    context. This happens specifically in a retrieval. To get this working
81    seemlessly, the access-defining class must implement a close method.
82    This method will be called before the Data::Dumper dump takes place.
83    In that moment the access-defining class must get rid of all data
84    structures that cannot be reconstructed via the Data::Dumper dump,
85    such as database handles or C pointers.
86    
87  =item C<file> => I<fname>  =item C<file> => I<fname>
88    
89  The filename of the records file. Files for indexes will have I<fname>  The filename of the records file. Files for indexes will have I<fname>
90  as prefix. I<Mandatory>  as prefix. I<Mandatory>, but usually taken care of by the
91    WAIT::Database handle when the constructor is called via
92    WAIT::Database::create_table().
93    
94  =item C<name> => I<name>  =item C<name> => I<name>
95    
# Line 73  The name of this table. I<Mandatory> Line 97  The name of this table. I<Mandatory>
97    
98  =item C<attr> => [ I<attr> ... ]  =item C<attr> => [ I<attr> ... ]
99    
100  A reference to an array of attribute names. I<Mandatory>  A reference to an array of attribute names. WAIT will keep the
101    contents of these attributes in its table. I<Mandatory>
102    
103  =item C<djk> => [ I<attr> ... ]  =item C<djk> => [ I<attr> ... ]
104    
105  A reference to an array of attribute names which make up the  A reference to an array of attribute names which make up the
106  I<disjointness key>. Don't think about it - i's of no use yet;  I<disjointness key>. Don't think about it - it's of no use yet;
107    
108  =item C<layout> => I<layoutobj>  =item C<layout> => I<layoutobj>
109    
110  A reference to an external parser object. Defaults to anew instance of  A reference to an external parser object. Defaults to a new instance
111  C<WAIT::Parse::Base>  of C<WAIT::Parse::Base>. For an example implementation see
112    WAIT::Parse::Nroff. A layout class can be implemented as a singleton
113    class if you so like.
114    
115  =item C<access> => I<accesobj>  =item C<keyset> => I<keyset>
116    
117  A reference to a acces object for the external parts of tuples.  The set of attributes needed to identify a record. Defaults to all
118    attributes.
119    
120    =item C<invindex> => I<inverted index>
121    
122    A reference to an anon array defining attributes of each record that
123    need to be indexed. See the source of smakewhatis for how to set this
124    up.
125    
126  =back  =back
127    
# Line 98  sub new { Line 132  sub new {
132    my %parm = @_;    my %parm = @_;
133    my $self = {};    my $self = {};
134    
135      # Check for mandatory attrs early
136      $self->{name}     = $parm{name}     or croak "No name specified";
137      $self->{attr}     = $parm{attr}     or croak "No attributes specified";
138    
139    # Do that before we eventually add '_weight' to attributes.    # Do that before we eventually add '_weight' to attributes.
140    $self->{keyset}   = $parm{keyset}   || [[@{$parm{attr}}]];    $self->{keyset}   = $parm{keyset}   || [[@{$parm{attr}}]];
141    
142    $self->{mode}     = O_CREAT | O_RDWR;    $self->{mode}     = O_CREAT | O_RDWR;
143    
144    # Determine and set up subclass    # Determine and set up subclass
145    $type = ref($type) || $type;    $type = ref($type) || $type;
146    if (defined $parm{djk}) {    if (defined $parm{djk}) {
# Line 119  sub new { Line 159  sub new {
159    }    }
160    
161    $self->{file}     = $parm{file}     or croak "No file specified";    $self->{file}     = $parm{file}     or croak "No file specified";
162    if (-d  $self->{file} or !mkdir($self->{file}, 0775)) {    if (-d  $self->{file}){
163        warn "Warning: Directory '$self->{file}' already exists\n";
164      } elsif (!mkdir($self->{file}, 0775)) {
165      croak "Could not 'mkdir $self->{file}': $!\n";      croak "Could not 'mkdir $self->{file}': $!\n";
166    }    }
167    $self->{name}     = $parm{name}     or croak "No name specified";  
168    $self->{attr}     = $parm{attr}     or croak "No attributes specified";    my $lockmgr = LockFile::Simple->make(-autoclean => 1);
169      # aquire a write lock
170      $self->{write_lock} = $lockmgr->lock($self->{file} . '/write')
171        or die "Can't lock '$self->{file}/write'";
172    
173    $self->{djk}      = $parm{djk}      if defined $parm{djk};    $self->{djk}      = $parm{djk}      if defined $parm{djk};
174    $self->{layout}   = $parm{layout} || new WAIT::Parse::Base;    $self->{layout}   = $parm{layout} || new WAIT::Parse::Base;
175    $self->{access}   = $parm{access} if defined $parm{access};    $self->{access}   = $parm{access} if defined $parm{access};
# Line 142  sub new { Line 188  sub new {
188      my $att  = shift @{$parm{invindex}};      my $att  = shift @{$parm{invindex}};
189      my @spec = @{shift @{$parm{invindex}}};      my @spec = @{shift @{$parm{invindex}}};
190      my @opt;      my @opt;
191        
192      if (ref($spec[0])) {      if (ref($spec[0])) {
193        carp "Secondary pipelines are deprecated\n";        carp "Secondary pipelines are deprecated\n";
194        @opt = %{shift @spec};        @opt = %{shift @spec};
195      }      }
196      $self->create_inverted_index(attribute => $att, pipeline  => \@spec, @opt);      $self->create_inverted_index(attribute => $att, pipeline  => \@spec, @opt);
197    }    }
198    
199    $self;    $self;
200    # end of backwarn compatibility stuff    # end of backwarn compatibility stuff
201  }  }
# Line 168  table! Line 215  table!
215    
216  sub create_index {  sub create_index {
217    my $self= shift;    my $self= shift;
218      
219    croak "Cannot create index for table aready populated"    croak "Cannot create index for table aready populated"
220      if $self->{nextk} > 1;      if $self->{nextk} > 1;
221      
222    require WAIT::Index;    require WAIT::Index;
223      
224    my $name = join '-', @_;    my $name = join '-', @_;
225    $self->{indexes}->{$name} =    $self->{indexes}->{$name} =
226      new WAIT::Index file => $self->{file}.'/'.$name, attr => $_;      new WAIT::Index file => $self->{file}.'/'.$name, attr => $_;
# Line 196  set attributes specified when the table Line 243  set attributes specified when the table
243    
244  =item C<pipeline>  =item C<pipeline>
245    
246  A piplines specification is a reference to and array of method names  A piplines specification is a reference to an array of method names
247  (from package C<WAIT::Filter>) which are to applied in sequence to the  (from package C<WAIT::Filter>) which are to be applied in sequence to
248  contents of the named attribute. The attribute name may not be in the  the contents of the named attribute. The attribute name may not be in
249  attribute list.  the attribute list.
250    
251  =item C<predicate>  =item C<predicate>
252    
253  An indication which predicate the index implements. This may be  An indication which predicate the index implements. This may be
254  e.g. 'plain', 'stemming' or 'soundex'. The indicator will be used for  e.g. 'plain', 'stemming' or 'soundex'. The indicator will be used for
255  query processing. Currently there is no standard set of predicate  query processing. Currently there is no standard set of predicate
256  names. The predicate defaults to the last member of the ppline if  names. The predicate defaults to the last member of the pipeline if
257  omitted.  omitted.
258    
259  =back  =back
# Line 224  sub create_inverted_index { Line 271  sub create_inverted_index {
271    croak "No pipeline specified"  unless $parm{pipeline};    croak "No pipeline specified"  unless $parm{pipeline};
272    
273    $parm{predicate} ||= $parm{pipeline}->[-1];    $parm{predicate} ||= $parm{pipeline}->[-1];
274      
275    croak "Cannot create index for table aready populated"    croak "Cannot create index for table aready populated"
276      if $self->{nextk} > 1;      if $self->{nextk} > 1;
277      
278    require WAIT::InvertedIndex;    require WAIT::InvertedIndex;
279    
280    # backward compatibility stuff    # backward compatibility stuff
# Line 235  sub create_inverted_index { Line 282  sub create_inverted_index {
282    for (qw(attribute pipeline predicate)) {    for (qw(attribute pipeline predicate)) {
283      delete $opt{$_};      delete $opt{$_};
284    }    }
285      
286    my $name = join '_', ($parm{attribute}, @{$parm{pipeline}});    my $name = join '_', ($parm{attribute}, @{$parm{pipeline}});
287    my $idx = new WAIT::InvertedIndex(file   => $self->{file}.'/'.$name,    my $idx = new WAIT::InvertedIndex(file   => $self->{file}.'/'.$name,
288                                      filter => [@{$parm{pipeline}}], # clone                                      filter => [@{$parm{pipeline}}], # clone
# Line 284  sub drop { Line 331  sub drop {
331        $_->drop;        $_->drop;
332      }      }
333      unlink "$file/records";      unlink "$file/records";
334        # $self->unlock;
335      ! (!-e $file or rmdir $file);      ! (!-e $file or rmdir $file);
336    } else {    } else {
337      croak ref($self)."::drop called directly";      croak ref($self)."::drop called directly";
# Line 334  sub open { Line 382  sub open {
382                           $self->{mode}, 0664, $DB_BTREE);                           $self->{mode}, 0664, $DB_BTREE);
383      }      }
384    }    }
385    
386      # Locking
387      #
388      # We allow multiple readers to coexists.  But write access excludes
389      # all read access vice versa.  In practice read access on tables
390      # open for writing will mostly work ;-)
391    
392      my $lockmgr = LockFile::Simple->make(-autoclean => 1);
393    
394      # aquire a write lock. We might hold one acquired in create() already
395      $self->{write_lock} ||= $lockmgr->lock($self->{file} . '/write')
396        or die "Can't lock '$self->{file}/write'";
397    
398      my $lockdir = $self->{file} . '/read';
399      unless (-d $lockdir) {
400        mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";
401      }
402    
403      if ($self->{mode} & O_RDWR) {
404        # this is a hack.  We do not check for reopening ...
405        return $self if $self->{write_lock};
406        
407        # If we actually want to write we must check if there are any readers
408        opendir DIR, $lockdir or
409          die "Could not opendir '$lockdir': $!";
410        for my $lockfile (grep { -f "$lockdir/$_" } readdir DIR) {
411          # check if the locks are still valid.
412          # Since we are protected by a write lock, we could use a pline file.
413          # But we want to use the stale testing from LockFile::Simple.
414          if (my $lck = $lockmgr->trylock("$lockdir/$lockfile")) {
415            warn "Removing stale lockfile '$lockdir/$lockfile'";
416            $lck->release;
417          } else {
418            $self->{write_lock}->release;
419            die "Cannot write table '$file' while it's in use";
420          }
421        }
422      } else {
423        # this is a hack.  We do not check for reopening ...
424        return $self if $self->{read_lock};
425        
426        # We are a reader. So we release the write lock
427        my $id = time;
428        while (-f "$lockdir/$id.lock") { # here assume ".lock" format!
429          $id++;
430        }
431        $self->{read_lock} = $lockmgr->lock("$lockdir/$id");
432        $self->{write_lock}->release;
433        delete $self->{write_lock};
434      }
435    
436    $self;    $self;
437  }  }
438    
439  sub fetch_extern {  sub fetch_extern {
440    my $self  = shift;    my $self  = shift;
441    
442    print "#@_", $self->{'access'}->{Mode}, "\n";    # print "#@_", $self->{'access'}->{Mode}, "\n"; # DEBUGGING?
443    if (exists $self->{'access'}) {    if (exists $self->{'access'}) {
444      mrequire ref($self->{'access'});      mrequire ref($self->{'access'});
445      $self->{'access'}->FETCH(@_);      $self->{'access'}->FETCH(@_);
# Line 358  sub _find_index { Line 457  sub _find_index {
457    my (@att) = @_;    my (@att) = @_;
458    my %att;    my %att;
459    my $name;    my $name;
460      
461    @att{@att} = @att;    @att{@att} = @att;
462    
463    KEY: for $name (keys %{$self->{indexes}}) {    KEY: for $name (keys %{$self->{indexes}}) {
# Line 375  sub have { Line 474  sub have {
474    my $self  = shift;    my $self  = shift;
475    my %parm  = @_;    my %parm  = @_;
476    
477    my $index = $self->_find_index(keys %parm);    my $index = $self->_find_index(keys %parm) or return; # no index-no have
478    croak "No index found" unless $index;  
479    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
480    return $index->have(@_);    return $index->have(@_);
481  }  }
# Line 387  sub insert { Line 486  sub insert {
486    
487    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
488    
489      # We should move all writing methods to a subclass to check only once
490      $self->{mode} & O_RDWR or croak "Cannot insert into table opened in RD_ONLY mode";
491    
492    my $tuple = join($;, map($parm{$_} || '', @{$self->{attr}}));    my $tuple = join($;, map($parm{$_} || '', @{$self->{attr}}));
493    my $key;    my $key;
494    my @deleted = keys %{$self->{deleted}};    my @deleted = keys %{$self->{deleted}};
495      my $gotkey = 0;
496    
497    if (@deleted) {    if (@deleted) {
498      $key = pop @deleted;      $key = pop @deleted;
499      delete $self->{deleted}->{$key};      delete $self->{deleted}->{$key};
500        # Sanity check
501        if ($key && $key>0) {
502          $gotkey=1;
503    } else {    } else {
504          warn(sprintf("WAIT database inconsistency during insert ".
505                       "key[%s]: Please rebuild index\n",
506                       $key
507                      ));
508        }
509      }
510      unless ($gotkey) {
511      $key = $self->{nextk}++;      $key = $self->{nextk}++;
512    }    }
513    if ($USE_RECNO) {    if ($USE_RECNO) {
# Line 408  sub insert { Line 521  sub insert {
521        if ($key == $self->{nextk}-1) {        if ($key == $self->{nextk}-1) {
522          $self->{nextk}--;          $self->{nextk}--;
523        } else {        } else {
524            # warn "setting key[$key] deleted during insert";
525          $self->{deleted}->{$key}=1;          $self->{deleted}->{$key}=1;
526        }        }
527        my $idx;        my $idx;
# Line 416  sub insert { Line 530  sub insert {
530          $idx->remove($key, %parm);          $idx->remove($key, %parm);
531        }        }
532        return undef;        return undef;
533      }      }
534    }    }
535    if (defined $self->{inverted}) {    if (defined $self->{inverted}) {
536      my $att;      my $att;
# Line 432  sub insert { Line 546  sub insert {
546    
547  sub sync {  sub sync {
548    my $self  = shift;    my $self  = shift;
549      
550    for (values %{$self->{indexes}}) {    for (values %{$self->{indexes}}) {
551      map $_->sync, $_;      map $_->sync, $_;
552    }    }
# Line 449  sub fetch { Line 563  sub fetch {
563    my $key   = shift;    my $key   = shift;
564    
565    return () if exists $self->{deleted}->{$key};    return () if exists $self->{deleted}->{$key};
566      
567    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
568    if ($USE_RECNO) {    if ($USE_RECNO) {
569      $self->unpack($self->{db}->[$key]);      $self->unpack($self->{db}->[$key]);
# Line 462  sub delete_by_key { Line 576  sub delete_by_key {
576    my $self  = shift;    my $self  = shift;
577    my $key   = shift;    my $key   = shift;
578    
579      unless ($key) {
580        Carp::cluck "Warning: delete_by_key called without key. Looks like a bug in WAIT?";
581        return;
582      }
583    
584    return $self->{deleted}->{$key} if defined $self->{deleted}->{$key};    return $self->{deleted}->{$key} if defined $self->{deleted}->{$key};
585    my %tuple = $self->fetch($key);    my %tuple = $self->fetch($key);
586    for (values %{$self->{indexes}}) {    for (values %{$self->{indexes}}) {
# Line 478  sub delete_by_key { Line 597  sub delete_by_key {
597        }        }
598      }      }
599    }    }
600      # warn "setting key[$key] deleted during delete_by_key";
601    ++$self->{deleted}->{$key};    ++$self->{deleted}->{$key};
602  }  }
603    
604  sub delete {  sub delete {
605    my $self  = shift;    my $self  = shift;
606    my $tkey = $self->have(@_);    my $tkey = $self->have(@_);
607      # warn "tkey[$tkey]\@_[@_]";
608    defined $tkey && $self->delete_by_key($tkey, @_);    defined $tkey && $self->delete_by_key($tkey, @_);
609  }  }
610    
611  sub unpack {  sub unpack {
612    my $self = shift;    my $self = shift;
613    my $tuple = shift;    my $tuple = shift;
614      return unless defined $tuple;
615    
616    my $att;    my $att;
617    my @result;    my @result;
# Line 502  sub unpack { Line 623  sub unpack {
623    @result;    @result;
624  }  }
625    
626    sub set {
627      my ($self, $iattr, $value) = @_;
628      
629      return unless $self->{write_lock};
630      for my $att (keys %{$self->{inverted}}) {
631        if ($] > 5.003) {         # avoid bug in perl up to 5.003_05
632          my $idx;
633          for $idx (@{$self->{inverted}->{$att}}) {
634            $idx->set($iattr, $value);
635          }
636        } else {
637          map $_->set($iattr, $value), @{$self->{inverted}->{$att}};
638        }
639      }
640    
641      1;
642    }
643    
644  sub close {  sub close {
645    my $self = shift;    my $self = shift;
646    
# Line 509  sub close { Line 648  sub close {
648      eval {$self->{'access'}->close}; # dont bother if not opened      eval {$self->{'access'}->close}; # dont bother if not opened
649    }    }
650    for (values %{$self->{indexes}}) {    for (values %{$self->{indexes}}) {
651        require WAIT::Index;
652      $_->close();      $_->close();
653    }    }
654    if (defined $self->{inverted}) {    if (defined $self->{inverted}) {
# Line 535  sub close { Line 675  sub close {
675      delete $self->{db};      delete $self->{db};
676    }    }
677    
678      $self->unlock;
679      
680    1;    1;
681  }  }
682    
683    sub unlock {
684      my $self = shift;
685    
686      # Either we have a read or a write lock (or we close the table already)
687      # unless ($self->{read_lock} || $self->{write_lock}) {
688      #   warn "WAIT::Table::unlock: Table aparently hold's no lock"
689      # }
690      if ($self->{write_lock}) {
691        $self->{write_lock}->release();
692        delete $self->{write_lock};
693      }
694      if ($self->{read_lock}) {
695        $self->{read_lock}->release();
696        delete $self->{read_lock};
697      }
698    
699    }
700    
701    sub DESTROY {
702      my $self = shift;
703    
704      warn "Table handle destroyed without closing it first"
705        if $self->{write_lock} || $self->{read_lock};
706    }
707    
708  sub open_scan {  sub open_scan {
709    my $self = shift;    my $self = shift;
710    my $code = shift;    my $code = shift;
# Line 593  sub intervall { Line 760  sub intervall {
760  }  }
761    
762  sub search {  sub search {
763    my $self = shift;    my $self  = shift;
764    my $attr = shift;    my ($query, $attr, $cont, $raw);
765    my $cont = shift;    if (ref $_[0]) {
766    my $raw  = shift;      $query = shift;
767      
768        $attr = $query->{attr};
769        $cont = $query->{cont};
770        $raw  = $query->{raw};
771      } else {
772        require Carp;
773        Carp::cluck("Using three argument search interface is deprecated, use hashref interface instead");
774        $attr = shift;
775        $cont = shift;
776        $raw  = shift;
777        $query = {
778                  attr => $attr,
779                  cont => $cont,
780                  raw  => $raw,
781                 };
782      }
783    
784    my %result;    my %result;
785    
786    defined $self->{db} or $self->open; # require layout    defined $self->{db} or $self->open; # require layout
# Line 606  sub search { Line 790  sub search {
790        my $name = $_->name;        my $name = $_->name;
791        if (exists $raw->{$name} and @{$raw->{$name}}) {        if (exists $raw->{$name} and @{$raw->{$name}}) {
792          my $scale = 1/scalar(@{$raw->{$name}});          my $scale = 1/scalar(@{$raw->{$name}});
793          my %r = $_->search_raw(@{$raw->{$name}});          my %r = $_->search_raw($query, @{$raw->{$name}});
794          my ($key, $val);          my ($key, $val);
795          while (($key, $val) = each %r) {          while (($key, $val) = each %r) {
796            if (exists $result{$key}) {            if (exists $result{$key}) {
# Line 620  sub search { Line 804  sub search {
804    }    }
805    if (defined $cont and $cont ne '') {    if (defined $cont and $cont ne '') {
806      for (@{$self->{inverted}->{$attr}}) {      for (@{$self->{inverted}->{$attr}}) {
807        my %r = $_->search($cont);        my %r = $_->search($query, $cont);
808        my ($key, $val);        my ($key, $val);
809        while (($key, $val) = each %r) {        while (($key, $val) = each %r) {
810          if (exists $result{$key}) {          if (exists $result{$key}) {
# Line 644  sub hilight_positions { Line 828  sub hilight_positions {
828    my %pos;    my %pos;
829    
830    if (defined $raw) {    if (defined $raw) {
831      for (@{$self->{inverted}->{$attr}}) {      for (@{$self->{inverted}->{$attr}}) { # objects of type
832                                              # WAIT::InvertedIndex for
833                                              # this index field $attr
834        my $name = $_->name;        my $name = $_->name;
835        if (exists $raw->{$name}) {        if (exists $raw->{$name}) {
836          my %qt;          my %qt;
# Line 678  sub hilight_positions { Line 864  sub hilight_positions {
864  }  }
865    
866  sub hilight {  sub hilight {
867    my ($tb, $text, $query, $raw) = @_;    my ($tb, $buf, $qplain, $qraw) = @_;
868    my $type = $tb->layout();    my $layout = $tb->layout();
869    
870    my @result;    my @result;
871    
872    $query ||= {};    $qplain ||= {};
873    $raw   ||= {};    $qraw   ||= {};
874    my @ttxt = $type->tag($text);    my @ttxt = $layout->tag($buf);
875    while (@ttxt) {    while (@ttxt) {
876      no strict 'refs';      no strict 'refs';
877      my %tag = %{shift @ttxt};      my %tag = %{shift @ttxt};
# Line 692  sub hilight { Line 879  sub hilight {
879      my $fld;      my $fld;
880    
881      my %hl;      my %hl;
882      for $fld (grep defined $tag{$_}, keys %$query, keys %$raw) {      for $fld (grep defined $tag{$_}, keys %$qplain, keys %$qraw) {
883        my $hp = $tb->hilight_positions($fld, $txt,        my $hp = $tb->hilight_positions($fld, $txt,
884                                        $query->{$fld}, $raw->{$fld});                                        $qplain->{$fld}, $qraw->{$fld});
885        for (keys %$hp) {        for (keys %$hp) {
886          if (exists $hl{$_}) {   # -w ;-(          if (exists $hl{$_}) {   # -w ;-(
887            $hl{$_} = max($hl{$_}, $hp->{$_});            $hl{$_} = max($hl{$_}, $hp->{$_});
# Line 720  sub hilight { Line 907  sub hilight {
907  }  }
908    
909  1;  1;
   
Legend:
Removed from v.10  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26