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