consistently load the managed images directory from the config file
[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.002";
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   my $priority = $self->{cfg}->entry("search", "index_priority", "speed");
22   if ($priority eq "speed") {
23     $self->{index} = {};
24   }
25   elsif ($priority eq "memory") {
26     require DBM::Deep;
27     require File::Temp;
28     my $fh = File::Temp->new;
29     $self->{index} = DBM::Deep->new
30       (
31        fh => $fh,
32        locking => 0,
33        autoflush => 0,
34        data_sector_size => 256,
35       );
36     $self->{fh} = $fh;
37     $self->{filename} = $fh->filename;
38   }
39   else {
40     die "Unknown [search].index_priority of '$priority'\n";
41   }
42   $self->{priority} = $priority;
43
44   $self->{decay_multiplier} = 0.4;
45
46   $self->{wordre} = $self->{cfg}->entry("search", "wordre", "\\w+");
47
48   return $self;
49 }
50
51 sub start_index {
52   my $self = shift;
53
54   my $data_dir = cfg_data_dir();
55   my $stopwords = "$data_dir/stopwords.txt";
56
57   # load the stop words
58   open STOP, "< $stopwords"
59     or die "Cannot open $stopwords: $!";
60   chomp(my @stopwords = <STOP>);
61   tr/\r//d for @stopwords; # just in case
62   my %stopwords;
63   @stopwords{@stopwords} = (1) x @stopwords;
64   close STOP;
65   $self->{weights} = {};
66
67   return 1;
68 }
69
70 sub process_article {
71   my ($self, $article, $section, $indexas, $fields) = @_;
72
73   $self->{weights}{$indexas} ||= {};
74   for my $field (sort { $self->{scores}{$b} <=> $self->{scores}{$a} }
75                  keys %$fields) {
76     my $word_re = $self->{cfg}->entry("search", "wordre_$field", $self->{wordre});
77     my $text = $fields->{$field};
78     my $score = $self->{scores}{$field};
79     my %seen; # $seen{phrase} non-zero if seen for this field
80     
81     # for each paragraph
82     for my $para (split /\n/, $text) {
83       my @words;
84       while ($para =~ /($word_re)/g) {
85         push @words, $1;
86       }
87       my @buffer;
88       
89       for my $word (@words) {
90         if ($self->{stopwords}{lc $word}) {
91           $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen,
92                          @buffer) if @buffer;
93           @buffer = ();
94         }
95         else {
96           push(@buffer, $word);
97         }
98       }
99       $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen,
100                      @buffer) if @buffer;
101     }
102     if ($field eq 'product_code' && $text) {
103       $self->process($indexas, $section->{id}, $score, $self->{weights}{$indexas}, \%seen, $text);
104     }
105   }
106 }
107
108 sub process {
109   my ($self, $id, $sectionid, $score, $weights, $seen, @words) = @_;
110   
111   for (my $start = 0; $start < @words; ++$start) {
112     my $end = $start + $MAXPHRASE-1;
113     $end = $#words if $end > $#words;
114     
115     for my $phrase (map { "@words[$start..$_]" } $start..$end) {
116       if (lc $phrase ne $phrase && !$seen->{lc $phrase}++) {
117         my $temp = $self->{index}{lc $phrase};
118         if (exists $temp->{$id}) {
119           $weights->{lc $phrase} *= $self->{decay_multiplier};
120           $temp->{$id}[1] += $score * $weights->{lc $phrase};
121         }
122         else {
123           $weights->{lc $phrase} = 1.0;
124           $temp->{$id} = [ $sectionid, $score ];
125         }
126         $self->{index}{lc $phrase} = $temp;
127       }
128       if (!$seen->{$phrase}++) {
129         my $temp = $self->{index}{$phrase};
130         if (exists $temp->{$id}) {
131           $weights->{$phrase} *= $self->{decay_multiplier};
132           $temp->{$id}[1] += $score * $weights->{$phrase};
133         }
134         else {
135           $weights->{$phrase} = 1.0;
136           $temp->{$id} = [ $sectionid, $score ];
137         }
138         $self->{index}{$phrase} = $temp;
139       }
140     }
141   }
142 }
143
144 sub end_index {
145   my $self = shift;
146
147   $self->{dropIndex}->execute()
148     or die "dropIndex failed: ", $self->{dropindex}->errstr, "\n";
149
150   my $insertIndex = $self->{insertIndex};
151   for my $key (sort keys %{$self->{index}}) {
152     my $word = $self->{index}{$key};
153     # sort by reverse score so that if we overflow the field we
154     # get the highest scoring matches
155     my @ids = sort { $word->{$b}[1] <=> $word->{$a}[1] } keys %$word;
156     my @sections = map { $_->[0] } @$word{@ids};
157     my @scores = map { $_->[1] } @$word{@ids};
158     
159     $insertIndex->execute($key, "@ids", "@sections", "@scores")
160       or die "Cannot insert into index: ", $insertIndex->errstr;
161   }
162
163   if ($self->{priority} eq "memory") {
164     delete $self->{dbm};
165     delete $self->{fh};
166     unlink $self->{filename};
167   }
168 }
169
170 1;