first set of search and indexing changes, commit so I won't break them
[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($DATADIR $MAXPHRASE);
6
7 sub new {
8   my ($class, %opts) = @_;
9
10   my $self = bless \%opts, $class;
11
12   $self->{dh} = BSE::DB->single;
13   $self->{dropIndex} = $self->{dh}->stmt('dropIndex')
14     or die "No dropIndex member in BSE::DB";
15   $self->{insertIndex} = $self->{dh}->stmt('insertIndex')
16     or die "No insertIndex member in BSE::DB";
17   $self->{index} = {};
18
19   $self->{decay_multiplier} = 0.4;
20
21   return $self;
22 }
23
24 sub start_index {
25   my $self = shift;
26
27   my $stopwords = "$DATADIR/stopwords.txt";
28
29   # load the stop words
30   open STOP, "< $stopwords"
31     or die "Cannot open $stopwords: $!";
32   chomp(my @stopwords = <STOP>);
33   tr/\r//d for @stopwords; # just in case
34   my %stopwords;
35   @stopwords{@stopwords} = (1) x @stopwords;
36   close STOP;
37
38
39   return 1;
40 }
41
42 sub process_article {
43   my ($self, $article, $section, $indexas, $fields) = @_;
44
45   my %weights;
46
47   for my $field (sort { $self->{scores}{$b} <=> $self->{scores}{$a} }
48                  keys %$fields) {
49     my $text = $fields->{$field};
50     my $score = $self->{scores}{$field};
51     my %seen; # $seen{phrase} non-zero if seen for this field
52     
53     # for each paragraph
54     for my $para (split /\n/, $text) {
55       my @words = split /\W+/, $para;
56       my @buffer;
57       
58       for my $word (@words) {
59         if ($self->{stopwords}{lc $word}) {
60           $self->process($indexas, $section->{id}, $score, \%weights, \%seen,
61                          @buffer) if @buffer;
62           @buffer = ();
63         }
64         else {
65           push(@buffer, $word);
66         }
67       }
68       $self->process($indexas, $section->{id}, $score, \%weights, \%seen,
69                      @buffer) if @buffer;
70     }
71   }
72 }
73
74 sub process {
75   my ($self, $id, $sectionid, $score, $weights, $seen, @words) = @_;
76   
77   for (my $start = 0; $start < @words; ++$start) {
78     my $end = $start + $MAXPHRASE-1;
79     $end = $#words if $end > $#words;
80     
81     for my $phrase (map { "@words[$start..$_]" } $start..$end) {
82       if (lc $phrase ne $phrase && !$seen->{lc $phrase}++) {
83         if (exists $self->{index}{lc $phrase}{$id}) {
84           $weights->{lc $phrase} *= $self->{decay_multiplier};
85           $self->{index}{lc $phrase}{$id}[1] += 
86             $score * $weights->{lc $phrase};
87         }
88         else {
89           $weights->{lc $phrase} = 1.0;
90           $self->{index}{lc $phrase}{$id} = [ $sectionid, $score ];
91         }
92       }
93       if (!$seen->{$phrase}++) {
94         if (exists $self->{index}{$phrase}{$id}) {
95           $weights->{$phrase} *= $self->{decay_multiplier};
96           $self->{index}{$phrase}{$id}[1] += 
97             $score * $weights->{$phrase};
98         }
99         else {
100           $weights->{$phrase} = 1.0;
101           $self->{index}{$phrase}{$id} = [ $sectionid, $score ];
102         }
103       }
104     }
105   }
106 }
107
108 sub end_index {
109   my $self = shift;
110
111   $self->{dropIndex}->execute()
112     or die "dropIndex failed: ", $self->{dropindex}->errstr, "\n";
113
114   my $insertIndex = $self->{insertIndex};
115   for my $key (sort keys %{$self->{index}}) {
116     my $word = $self->{index}{$key};
117     # sort by reverse score so that if we overflow the field we
118     # get the highest scoring matches
119     my @ids = sort { $word->{$b}[1] <=> $word->{$a}[1] } keys %$word;
120     my @sections = map { $_->[0] } @$word{@ids};
121     my @scores = map { $_->[1] } @$word{@ids};
122     
123     $insertIndex->execute($key, "@ids", "@sections", "@scores")
124       or die "Cannot insert into index: ", $insertIndex->errstr;
125   }
126 }
127
128 1;