optional case-insensitivity for searching
[bse.git] / site / cgi-bin / modules / BSE / Index / BSE.pm
1 package BSE::Index::BSE;
2 use strict;
3 use base 'BSE::Index::Base';
4 use BSE::DB;
5 use Constants qw($MAXPHRASE);
6 use BSE::CfgInfo qw(cfg_data_dir);
7
8 our $VERSION = "1.004";
9
10 sub new {
11   my ($class, %opts) = @_;
12
13   my $self = bless \%opts, $class;
14
15   $self->{dh} = BSE::DB->single;
16   $self->{dropIndex} = $self->{dh}->stmt('dropIndex')
17     or die "No dropIndex member in BSE::DB";
18   $self->{insertIndex} = $self->{dh}->stmt('insertIndex')
19     or die "No insertIndex member in BSE::DB";
20
21   $self->{case} eq 'controlled'
22     and die "BSE built-in searcher doesn't support controlled search (yet)";
23
24   my $priority = $self->{cfg}->entry("search", "index_priority", "speed");
25   if ($priority eq "speed") {
26     $self->{index} = {};
27   }
28   elsif ($priority eq "memory") {
29     eval { require DBM::Deep; 1 }
30       or die "DBM::Deep must be installed to use [search].index_priority=memory\n";
31     require File::Temp;
32     my $fh = File::Temp->new;
33     $self->{index} = DBM::Deep->new
34       (
35        fh => $fh,
36        locking => 0,
37        autoflush => 0,
38        data_sector_size => 256,
39       );
40     $self->{fh} = $fh;
41     $self->{filename} = $fh->filename;
42   }
43   else {
44     die "Unknown [search].index_priority of '$priority'\n";
45   }
46   $self->{priority} = $priority;
47
48   $self->{decay_multiplier} = 0.4;
49
50   $self->{wordre} = $self->{cfg}->entry("search", "wordre", "\\w+");
51
52   return $self;
53 }
54
55 sub start_index {
56   my $self = shift;
57
58   my $data_dir = cfg_data_dir();
59   my $stopwords = "$data_dir/stopwords.txt";
60
61   # load the stop words
62   open STOP, "< $stopwords"
63     or die "Cannot open $stopwords: $!";
64   chomp(my @stopwords = <STOP>);
65   tr/\r//d for @stopwords; # just in case
66   my %stopwords;
67   @stopwords{@stopwords} = (1) x @stopwords;
68   close STOP;
69   $self->{weights} = {};
70
71   return 1;
72 }
73
74 sub process_article {
75   my ($self, $article, $section, $indexas, $fields) = @_;
76
77   $self->{weights}{$indexas} ||= {};
78   for my $field (sort { $self->{scores}{$b} <=> $self->{scores}{$a} }
79                  keys %$fields) {
80     my $word_re = $self->{cfg}->entry("search", "wordre_$field", $self->{wordre});
81     my $text = $fields->{$field};
82     my $score = $self->{scores}{$field};
83     my %seen; # $seen{phrase} non-zero if seen for this field
84     
85     # for each paragraph
86     for my $para (split /\n/, $text) {
87       my @words;
88       while ($para =~ /($word_re)/g) {
89         push @words, $1;
90       }
91       my @buffer;
92       
93       for my $word (@words) {
94         if ($self->{stopwords}{lc $word}) {
95           $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen,
96                          @buffer) if @buffer;
97           @buffer = ();
98         }
99         else {
100           push(@buffer, $word);
101         }
102       }
103       $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen,
104                      @buffer) if @buffer;
105     }
106     if ($field eq 'product_code' && $text) {
107       $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen, $text);
108     }
109   }
110 }
111
112 sub process {
113   my ($self, $id, $sectionid, $score, $weights, $seen, @words) = @_;
114   
115   for (my $start = 0; $start < @words; ++$start) {
116     my $end = $start + $MAXPHRASE-1;
117     $end = $#words if $end > $#words;
118     
119     for my $phrase (map { "@words[$start..$_]" } $start..$end) {
120       if ($self->{case} eq 'context') {
121         if (lc $phrase ne $phrase && !$seen->{lc $phrase}++) {
122           my $temp = $self->{index}{lc $phrase};
123           if (exists $temp->{$id}) {
124             $weights->{lc $phrase} *= $self->{decay_multiplier};
125             $temp->{$id}[1] += $score * $weights->{lc $phrase};
126           }
127           else {
128             $weights->{lc $phrase} = 1.0;
129             $temp->{$id} = [ $sectionid, $score ];
130           }
131           $self->{index}{lc $phrase} = $temp;
132         }
133       }
134       else {
135         $phrase = lc $phrase;
136       }
137       if (!$seen->{$phrase}++) {
138         my $temp = $self->{index}{$phrase};
139         if (exists $temp->{$id}) {
140           $weights->{$phrase} *= $self->{decay_multiplier};
141           $temp->{$id}[1] += $score * $weights->{$phrase};
142         }
143         else {
144           $weights->{$phrase} = 1.0;
145           $temp->{$id} = [ $sectionid, $score ];
146         }
147         $self->{index}{$phrase} = $temp;
148       }
149     }
150   }
151 }
152
153 sub end_index {
154   my $self = shift;
155
156   $self->{dropIndex}->execute()
157     or die "dropIndex failed: ", $self->{dropindex}->errstr, "\n";
158
159   my $insertIndex = $self->{insertIndex};
160   for my $key (sort keys %{$self->{index}}) {
161     my $word = $self->{index}{$key};
162     # sort by reverse score so that if we overflow the field we
163     # get the highest scoring matches
164     my @ids = sort { $word->{$b}[1] <=> $word->{$a}[1] } keys %$word;
165     my @sections = map { $_->[0] } @$word{@ids};
166     my @scores = map { $_->[1] } @$word{@ids};
167     
168     $insertIndex->execute($key, "@ids", "@sections", "@scores")
169       or die "Cannot insert into index: ", $insertIndex->errstr;
170   }
171
172   if ($self->{priority} eq "memory") {
173     delete $self->{dbm};
174     delete $self->{fh};
175     unlink $self->{filename};
176   }
177 }
178
179 1;