first set of search and indexing changes, commit so I won't break them
authorTony Cook <tony@develop-help.com>
Wed, 26 Apr 2006 05:40:16 +0000 (05:40 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 26 Apr 2006 05:40:16 +0000 (05:40 +0000)
moving the search into a module

MANIFEST
site/cgi-bin/admin/makeIndex.pl
site/cgi-bin/modules/BSE/Index/BSE.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Index/Base.pm [new file with mode: 0644]
site/cgi-bin/search.pl
site/templates/search_base.tmpl

index 7ac3822..386fe6c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -78,6 +78,8 @@ site/cgi-bin/modules/BSE/Generate/Seminar.pm
 # site/cgi-bin/modules/BSE/FileEditor.pm
 site/cgi-bin/modules/BSE/Handler/Base.pm
 site/cgi-bin/modules/BSE/Handler/Page.pm
+site/cgi-bin/modules/BSE/Index/BSE.pm
+site/cgi-bin/modules/BSE/Index/Base.pm
 site/cgi-bin/modules/BSE/Mail.pm
 site/cgi-bin/modules/BSE/Mail/SMTP.pm
 site/cgi-bin/modules/BSE/Mail/Sendmail.pm
index d81de67..66a532d 100755 (executable)
@@ -16,17 +16,6 @@ if ($in_cgi) {
 my $cfg = BSE::Cfg->new;
 my $urlbase = $cfg->entryVar('site', 'url');
 
-my $stopwords = "$DATADIR/stopwords.txt";
-
-# load the stop words
-open STOP, "< $stopwords"
-  or die "Cannot open $stopwords: $!";
-chomp(my @stopwords = <STOP>);
-tr/\r//d for @stopwords; # just in case
-my %stopwords;
-@stopwords{@stopwords} = (1) x @stopwords;
-close STOP;
-
 my $articles = Articles->new;
 
 # scores depending on where the term appears
@@ -55,34 +44,18 @@ for my $name (keys %scores) {
 # instead
 my $max_level = $SEARCH_LEVEL;
 
+my $indexer_class = $cfg->entry('search', 'indexer', 'BSE::Index::BSE');
+(my $indexer_file = $indexer_class . ".pm") =~ s!::!/!g;
+require $indexer_file;
 # key is phrase, value is hashref with $id -> $sectionid
-my %index;
-makeIndex($articles);
-
-#use Data::Dumper;
-#print Dumper(\%index);
-
-my $dh = BSE::DB->single;
-my $dropIndex = $dh->stmt('dropIndex')
-  or die "No dropIndex member in BSE::DB";
-my $insertIndex = $dh->stmt('insertIndex')
-  or die "No insertIndex member in BSE::DB";
-
-$dropIndex->execute()
-  or die "Could not drop search index ",$dropIndex->errstr;
-
-for my $key (sort keys %index) {
-  my $word = $index{$key};
-  # sort by reverse score so that if we overflow the field we
-  # get the highest scoring matches
-  my @ids = sort { $word->{$b}[1] <=> $word->{$a}[1] } keys %$word;
-  my @sections = map { $_->[0] } @$word{@ids};
-  my @scores = map { $_->[1] } @$word{@ids};
-  #my @sections = map { $_->[0] } values %{$index{$key}};
-  #my @scores = map { $_->[1] } values %{$index{$key}};
-
-  $insertIndex->execute($key, "@ids", "@sections", "@scores")
-    or die "Cannot insert into index: ", $insertIndex->errstr;
+my $indexer = $indexer_class->new(cfg => $cfg, scores => \%scores);
+eval {
+  $indexer->start_index();
+  makeIndex($articles);
+  $indexer->end_index();
+};
+if ($@) {
+  print STDERR "Indexing error: $@\n";
 }
 
 if ($in_cgi) {
@@ -116,7 +89,8 @@ sub makeIndex {
     next unless $gen->visible($article) or $do_search{$sectionid};
     
     next if $dont_search{$sectionid};
-
+    
+    my %fields;
     for my $field (sort { $scores{$b} <=> $scores{$a} } keys %scores) {
 
       next unless $scores{$field};
@@ -140,43 +114,9 @@ sub makeIndex {
 
       next unless defined $text;
 
-      # for each paragraph
-      for my $para (split /\n/, $text) {
-       my @words = split /\W+/, $para;
-       my @buffer;
-
-       for my $word (@words) {
-         if ($stopwords{lc $word}) {
-           process($indexas, $sectionid, $scores{$field}, @buffer) if @buffer;
-           @buffer = ();
-         }
-         else {
-           push(@buffer, $word);
-         }
-       }
-       process($indexas, $sectionid, $scores{$field}, @buffer) if @buffer;
-      }
-    }
-  }
-}
-
-sub process {
-  my ($id, $sectionid, $score, @words) = @_;
-  
-  for (my $start = 0; $start < @words; ++$start) {
-    my $end = $start + $MAXPHRASE-1;
-    $end = $#words if $end > $#words;
-    
-    for my $phrase (map { "@words[$start..$_]" } $start..$end) {
-      if (!exists $index{lc $phrase}{$id}
-         || $score > $index{lc $phrase}{$id}[1]) {
-       $index{lc $phrase}{$id} = [ $sectionid, $score ];
-      }
-      if (!exists $index{$phrase}{$id}
-         || $score > $index{$phrase}{$id}[1]) {
-       $index{$phrase}{$id} = [ $sectionid, $score ];
-      }
+      $fields{$field} = $text;
     }
+    $indexer->process_article($article, $section, $indexas, \%fields);
   }
 }
 
diff --git a/site/cgi-bin/modules/BSE/Index/BSE.pm b/site/cgi-bin/modules/BSE/Index/BSE.pm
new file mode 100644 (file)
index 0000000..c96b603
--- /dev/null
@@ -0,0 +1,128 @@
+package BSE::Index::BSE;
+use strict;
+use base 'BSE::Index::Base';
+use BSE::DB;
+use Constants qw($DATADIR $MAXPHRASE);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  my $self = bless \%opts, $class;
+
+  $self->{dh} = BSE::DB->single;
+  $self->{dropIndex} = $self->{dh}->stmt('dropIndex')
+    or die "No dropIndex member in BSE::DB";
+  $self->{insertIndex} = $self->{dh}->stmt('insertIndex')
+    or die "No insertIndex member in BSE::DB";
+  $self->{index} = {};
+
+  $self->{decay_multiplier} = 0.4;
+
+  return $self;
+}
+
+sub start_index {
+  my $self = shift;
+
+  my $stopwords = "$DATADIR/stopwords.txt";
+
+  # load the stop words
+  open STOP, "< $stopwords"
+    or die "Cannot open $stopwords: $!";
+  chomp(my @stopwords = <STOP>);
+  tr/\r//d for @stopwords; # just in case
+  my %stopwords;
+  @stopwords{@stopwords} = (1) x @stopwords;
+  close STOP;
+
+
+  return 1;
+}
+
+sub process_article {
+  my ($self, $article, $section, $indexas, $fields) = @_;
+
+  my %weights;
+
+  for my $field (sort { $self->{scores}{$b} <=> $self->{scores}{$a} }
+                keys %$fields) {
+    my $text = $fields->{$field};
+    my $score = $self->{scores}{$field};
+    my %seen; # $seen{phrase} non-zero if seen for this field
+    
+    # for each paragraph
+    for my $para (split /\n/, $text) {
+      my @words = split /\W+/, $para;
+      my @buffer;
+      
+      for my $word (@words) {
+       if ($self->{stopwords}{lc $word}) {
+         $self->process($indexas, $section->{id}, $score, \%weights, \%seen,
+                        @buffer) if @buffer;
+         @buffer = ();
+       }
+       else {
+         push(@buffer, $word);
+       }
+      }
+      $self->process($indexas, $section->{id}, $score, \%weights, \%seen,
+                    @buffer) if @buffer;
+    }
+  }
+}
+
+sub process {
+  my ($self, $id, $sectionid, $score, $weights, $seen, @words) = @_;
+  
+  for (my $start = 0; $start < @words; ++$start) {
+    my $end = $start + $MAXPHRASE-1;
+    $end = $#words if $end > $#words;
+    
+    for my $phrase (map { "@words[$start..$_]" } $start..$end) {
+      if (lc $phrase ne $phrase && !$seen->{lc $phrase}++) {
+       if (exists $self->{index}{lc $phrase}{$id}) {
+         $weights->{lc $phrase} *= $self->{decay_multiplier};
+         $self->{index}{lc $phrase}{$id}[1] += 
+           $score * $weights->{lc $phrase};
+       }
+       else {
+         $weights->{lc $phrase} = 1.0;
+         $self->{index}{lc $phrase}{$id} = [ $sectionid, $score ];
+       }
+      }
+      if (!$seen->{$phrase}++) {
+       if (exists $self->{index}{$phrase}{$id}) {
+         $weights->{$phrase} *= $self->{decay_multiplier};
+         $self->{index}{$phrase}{$id}[1] += 
+           $score * $weights->{$phrase};
+       }
+       else {
+         $weights->{$phrase} = 1.0;
+         $self->{index}{$phrase}{$id} = [ $sectionid, $score ];
+       }
+      }
+    }
+  }
+}
+
+sub end_index {
+  my $self = shift;
+
+  $self->{dropIndex}->execute()
+    or die "dropIndex failed: ", $self->{dropindex}->errstr, "\n";
+
+  my $insertIndex = $self->{insertIndex};
+  for my $key (sort keys %{$self->{index}}) {
+    my $word = $self->{index}{$key};
+    # sort by reverse score so that if we overflow the field we
+    # get the highest scoring matches
+    my @ids = sort { $word->{$b}[1] <=> $word->{$a}[1] } keys %$word;
+    my @sections = map { $_->[0] } @$word{@ids};
+    my @scores = map { $_->[1] } @$word{@ids};
+    
+    $insertIndex->execute($key, "@ids", "@sections", "@scores")
+      or die "Cannot insert into index: ", $insertIndex->errstr;
+  }
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/Index/Base.pm b/site/cgi-bin/modules/BSE/Index/Base.pm
new file mode 100644 (file)
index 0000000..a8b7c2a
--- /dev/null
@@ -0,0 +1,55 @@
+package BSE::Index::Base;
+use strict;
+
+1;
+
+__END__
+
+=head1 NAME
+
+BSE::Index::Base - base class for BSE search engine indexers.
+
+=head1 METHODS
+
+An index must provide the following methods:
+
+=over
+
+=item new
+
+Class method.  Supplied with the following named parameters:
+
+=over
+
+=item cfg
+
+BSE::Cfg object or similar.
+
+=item scores
+
+Hash of field scores.  This can be ignored.
+
+=item callback
+
+Logging callback, optional.  A coderef that accepts a single string to
+be logged.
+
+=back
+
+=item start_index
+
+Object method called to start the indexing process.  No parameters.
+
+=item process_article
+
+Object method called to process a single article.  Accepts one
+parameter, the article to be indexed.
+
+=item end_index
+
+Object method called to finish indexing.
+
+=back
+
+=cut
+
index 2d572fc..2870c5c 100755 (executable)
@@ -53,9 +53,9 @@ if (@results) {
   $articles_end = $#results if $articles_end >= @results;
 
   if ($cfg->entry('search', 'keep_inaccessible')) {
-    for my $id (@results[$articles_start..$articles_end]) {
-      my $article = Articles->getByPkey($id)
-       or die "Cannot retrieve article $id\n";
+    for my $entry (@results[$articles_start..$articles_end]) {
+      my $article = Articles->getByPkey($entry->[0])
+       or die "Cannot retrieve article $entry->[0]\n";
       push(@articles, $article);
     }
   }
@@ -65,7 +65,7 @@ if (@results) {
     my $index = 0;
     my $seen = 0;
     while ($index < @results && $seen <= $articles_end) {
-      my $id = $results[$index];
+      my $id = $results[$index][0];
       my $article = Articles->getByPkey($id)
        or die "Cannot retrieve article $id\n";
       if ($req->siteuser_has_access($article)) {
@@ -79,7 +79,7 @@ if (@results) {
       }
       ++$index;
     }
-    @results = grep !$remove{$_}, @results;
+    @results = grep !$remove{$_->[0]}, @results;
   }
 }
 
@@ -100,6 +100,13 @@ my %sections = map { %$_ } @sections;
 # now a list of values ( in the correct order
 @sections = map { keys %$_ } @sections;
 
+my %scores = map @$_, @results;
+
+my $max_score = 0;
+for my $score (values %scores) {
+  $score > $max_score and $max_score = $score;
+}
+
 my $page_num_iter = 0;
 
 my $article_index = -1;
@@ -161,7 +168,12 @@ my %acts;
    },
    result => 
    sub { 
-     return escape_html($articles[$article_index]{$_[0]});
+     my $arg = shift;
+     my $art = $articles[$article_index];
+     if ($arg eq 'score') {
+       return sprintf("%.1f", 100.0 * $scores{$art->{id}} / $max_score);
+     }
+     return escape_html($art->{$arg});
    },
    date =>
    sub {
@@ -247,6 +259,44 @@ BSE::Template->show_page('search', $cfg, \%acts);
 
 undef $req;
 
+sub get_term_matches {
+  my ($term, $allow_wc) = @_;
+
+  my $sth;
+  if ($SEARCH_AUTO_WILDCARD && $allow_wc) {
+    $sth = $dh->stmt('searchIndexWC');
+    $sth->execute($term."%")
+      or die "Could not execute search: ",$sth->errstr;
+  }
+  else {
+    $sth = $dh->stmt('searchIndex');
+    $sth->execute($term)
+      or die "Could not execute search: ",$sth->errstr;
+  }
+  
+  my %matches;
+  while (my $row = $sth->fetchrow_arrayref) {
+    # skip any results that contain spaces if our term doesn't
+    # contain spaces.  This loses wildcard matches which hit
+    # phrase entries
+    next if $term !~ /\s/ && $row->[0] =~ /\s/;
+    my @ids = split ' ', $row->[1];
+    my @scores = split ' ', $row->[3];
+    if ($section) {
+      # only for the section requested
+      my @sections = split ' ', $row->[2];
+      my @keep = grep { $sections[$_] == $section && $ids[$_] } 0..$#sections;
+      @ids = @ids[@keep];
+      @scores = @scores[@keep];
+    }
+    for my $index (0 .. $#ids) {
+      $matches{$ids[$index]} += $scores[$index];
+    }
+  }
+
+  return map [ $_, $matches{$_} ], keys %matches;
+}
+
 sub getSearchResult {
   my ($words, $section, $date, $terms) = @_;
 
@@ -254,27 +304,43 @@ sub getSearchResult {
   #$words = lc $words;
   $words =~ s/^\s+|\s+$//g;
 
-  # array of [ term, unquoted ]
+  # array of [ term, unquoted, required, weight ]
   my @terms;
-  my $found = 1;
-  while ($found) {
-    $found = 0;
-    if ($words =~ /\G\s*"([^"]+)"/gc
+  my @exclude;
+  while (1) {
+    if ($words =~ /\G\s*-"([^"]+)"/gc
+       || $words =~ /\G\s*-'([^\']+)'/gc) {
+      push @exclude, [ $1, 0 ];
+    }
+    elsif ($words =~ /\G\s*\+"([^"]+)"/gc
+       || $words =~ /\G\s*\+'([^\']+)'/gc) {
+      push @terms, [ $1, 0, 1, 1 ];
+    }
+    elsif ($words =~ /\G\s*"([^"]+)"/gc
        || $words =~ /\G\s*'([^']+)'/gc) {
-      push(@terms, [ $1, 0 ]);
-      $found = 1;
+      push(@terms, [ $1, 0, 0, 1 ]);
+    }
+    elsif ($words =~ /\G\s*-(\S+)/gc) {
+      push @exclude, [ $1, 1 ];
+    }
+    elsif ($words =~ /\G\s*\+(\S+)/gc) {
+      push(@terms, [ $1, 1, 1, 1 ]);
     }
     elsif ($words =~ /\G\s*(\S+)/gc) {
-      push(@terms, [ $1, 1 ]);
-      $found = 1;
+      push(@terms, [ $1, 1, 0, 1 ]);
+    }
+    else {
+      last;
     }
   }
+  
+  @terms or return;
 
   # if the user entered a plain multi-word phrase
-  if ($words !~ /["']/ && $words =~ /\s/) {
+  if ($words !~ /["'+-]/ && $words =~ /\s/) {
     # treat it as if they entered it in quotes as well
     # giving articles with that phrase an extra score
-    push(@terms, [ $words, 0 ]);
+    push(@terms, [ $words, 0, 0, 0.1 ]);
   }
 
   # disable wildcarding for short terms
@@ -285,40 +351,36 @@ sub getSearchResult {
   }
 
   my %scores;
-  my $sth;
   my %terms;
-  for my $term (@terms) {
-    if ($SEARCH_AUTO_WILDCARD && $term->[1]) {
-      $sth = $dh->stmt('searchIndexWC');
-      $sth->execute($term->[0]."%")
-       or die "Could not execute search: ",$sth->errstr;
-       
-    }
-    else {
-      $sth = $dh->stmt('searchIndex');
-      $sth->execute($term->[0])
-       or die "Could not execute search: ",$sth->errstr;
+  for my $term (grep !$_->[2], @terms) {
+    my @matches = get_term_matches($term->[0], $term->[1]);
+    for my $match (@matches) {
+      $scores{$match->[0]} += $match->[1] * $term->[3];
     }
-
-    while (my $row = $sth->fetchrow_arrayref) {
-      # skip any results that contain spaces if our term doesn't
-      # contain spaces.  This loses wildcard matches which hit
-      # phrase entries
-      next if $term->[0] !~ /\s/ && $row->[0] =~ /\s/;
-      my @ids = split ' ', $row->[1];
-      my @scores = split ' ', $row->[3];
-      if ($section) {
-       # only for the section requested
-       my @sections = split ' ', $row->[2];
-       my @keep = grep { $sections[$_] == $section && $ids[$_] } 0..$#sections;
-       @ids = @ids[@keep];
-       @scores = @scores[@keep];
+  }
+  my @required = grep $_->[2], @terms;
+  my %delete; # has of id to 1
+  if (@required) {
+    my %match_required;
+    for my $term (@required) {
+      my @matches = get_term_matches($term->[0], $term->[1]);
+      for my $match (@matches) {
+       $scores{$match->[0]} += $match->[1];
+       ++$match_required{$match->[0]};
       }
-      for my $index (0..$#ids) {
-       $scores{$ids[$index]} += $scores[$index];
+    }
+    for my $id (keys %scores) {
+      if (!$match_required{$id} || $match_required{$id} != @required) {
+       ++$delete{$id};
       }
     }
   }
+  for my $term (@exclude) {
+    my @matches = get_term_matches($term->[0], $term->[1]);
+    ++$delete{$_->[0]} for @matches;
+  }
+
+  delete @scores{keys %delete};
 
   return () if !keys %scores;
 
@@ -355,7 +417,7 @@ sub getSearchResult {
        last SWITCH;
        };
   }
-  $sth = $dh->{dbh}->prepare($sql)
+  my $sth = $dh->{dbh}->prepare($sql)
     or die "Error preparing $sql: ",$dh->{dbh}->errstr;
 
   $sth->execute()
@@ -369,7 +431,7 @@ sub getSearchResult {
 
   @$terms = map $_->[0], @terms;
 
-  return @ids;
+  return map [ $_, $scores{$_} ], @ids;
 }
 
 sub _sql_date {
index 1e58884..bd907ec 100644 (file)
@@ -58,7 +58,7 @@
   <dd> <font face="Verdana, Arial, Helvetica, sans-serif" size="2"> <:excerpt:></font> 
     <br>
     <font face="Verdana, Arial, Helvetica, sans-serif" size="2" color="#808080"> 
-    Last modified on: <:date result lastModified:></font><:if Keywords:><br>
+    Last modified on: <:date result lastModified:> Score: <:result score:>%</font><:if Keywords:><br>
     <font face="Verdana, Arial, Helvetica, sans-serif" size="2" color="#808080"> 
     Keywords: <:keywords:></font><:or Keywords:><:eif Keywords:><:if Author:><br>
     <font face="Verdana, Arial, Helvetica, sans-serif" size="2" color="#808080">