/[swish]/trunk/html/swish.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/html/swish.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 21 by dpavlin, Tue Mar 18 20:20:11 2003 UTC revision 82 by dpavlin, Sun Aug 29 18:17:15 2004 UTC
# Line 3  Line 3 
3  use strict;  use strict;
4  use CGI qw/:standard -no_xhtml/;  use CGI qw/:standard -no_xhtml/;
5  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
6  use SWISH;  use SWISH::API;
7  use XML::Simple;  use XML::Simple;
8  use Lingua::Spelling::Alternative;  use Lingua::Spelling::Alternative;
9  use Text::Iconv;  use Text::Iconv;
10    use Data::Pageset;
11    
12    
13    sub get_snippet {
14            my $context_chars = 100;
15            my $max_desc = 16384;   # 16k to filter
16    
17            my $desc = shift || return '';
18            $desc = substr($desc,0,$max_desc) if (length($desc) > $max_desc);
19            # test if $desc contains any of our query words
20            my @snips;
21    
22            my @colors = qw{#ffff66 #a0ffff #99ff99 #ff9999 #ff66ff};
23    
24            my $i = 0;
25    
26            for my $q (@_) {
27                    if ($desc =~ m/(.*?)(\Q$q\E)(.*)/si) {
28                            my $bef = $1;
29                            my $qm = $2;
30                            my $af = $3;
31                            $bef = substr $bef, -$context_chars;
32                            $af = substr $af, 0, $context_chars;
33                            
34                            # no partial words...
35                            $af =~ s,^\S+\s+|\s+\S+$,,gs;
36                            $bef =~ s,^\S+\s+|\s+\S+$,,gs;
37    
38                            push(@snips, "$bef <span style=\"background:".$colors[$i]."; color:black;\">$qm</span> $af");
39                            $i++;
40                            $i = 0 if ($i > $#colors);
41                    }
42            }
43            my $ellip = ' ... ';
44            my $snippet = $ellip. join($ellip, @snips) . $ellip if (@snips);
45      
46            return $snippet;
47    }
48    
49    # for pager
50    my $pages_per_set = 20;
51    
52  Text::Iconv->raise_error(0);     # Conversion errors raise exceptions  Text::Iconv->raise_error(0);     # Conversion errors raise exceptions
53  my $config=XMLin(undef,  my $config=XMLin(undef,
54  #               keyattr => { label => "value" },  #               keyattr => { label => "value" },
55                  forcecontent => 0,                  forcecontent => 0,
56                    ForceArray => [ 'path' ],
57          );          );
58    
59  my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});  my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
60  sub x {  sub x {
61            return if (! defined $_[0]);
62          return $from_utf8->convert($_[0]);          return $from_utf8->convert($_[0]);
63  }  }
64    
65  use Data::Dumper;  # Escape <, >, & and ", and to produce valid XML
66  #print Dumper($config);  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
67    my $escape_re  = join '|' => keys %escape;
68    sub e {
69            my $out;
70            foreach my $v (@_) {
71                    $v =~ s/($escape_re)/$escape{$1}/g;
72                    $out .= $v;
73            }
74            return $out;
75    }
76    
77  my $spelling_alt;  my @spellings;
78  # FIX: doesn't work very well  # FIX: doesn't work very well
79  if ($config->{findaffix}) {  if ($config->{findaffix}) {
80          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $findaffix (split(/[, ]+/,x($config->{findaffix}))) {
81          $spelling_alt->load_findaffix(x($config->{findaffix}));                  next if (! -f $findaffix);
82                    my $spelling_alt = new Lingua::Spelling::Alternative;
83                    $spelling_alt->load_findaffix($findaffix);
84                    push @spellings,$spelling_alt;
85            }
86  }  }
87  if ($config->{affix}) {  if ($config->{affix}) {
88          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $affix (split(/[, ]+/,x($config->{affix}))) {
89          $spelling_alt->load_affix(x($config->{affix}));                  next if (! -f $affix);
90                    my $spelling_alt = new Lingua::Spelling::Alternative;
91                    $spelling_alt->load_affix($affix);
92                    push @spellings,$spelling_alt;
93            }
94  }  }
95    
96  my $hits=0;  my $hits=0;
97  my $max_hits=x($config->{max_hits});  my $max_hits=param('max_hits') || x($config->{max_hits});
98    
99  my %labels;  my %labels;
100  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
101            next if (! $_->{value});        # skip unlimited (0)
102          $labels{$_->{value}} = x($_->{content});          $labels{$_->{value}} = x($_->{content});
103  }  }
104    
105    my $path;
106    # limit to this path
107    $path .= '"'.join('*" or "',param('path')).'*"' if (param('path'));
108    my %path_label;
109    my @path_name;
110    foreach (@{$config->{paths}->{path}}) {
111    
112    print STDERR "##: $_->{limit}",x($_->{content}),"\n";
113            push @path_name,x($_->{limit});
114            $path_label{$_->{limit}} = x($_->{content});
115    }
116    
117    my @properties = split(/\s+/,x($config->{properties})) if ($config->{properties});
118    
119  if ($config->{charset}) {  if ($config->{charset}) {
120          print header(-charset=>x($config->{charset}));          print header(-charset=>x($config->{charset}));
121  } else {  } else {
# Line 52  print popup_menu(-name=>'max_hits',-valu Line 127  print popup_menu(-name=>'max_hits',-valu
127  print x($config->{text}->{documents});  print x($config->{text}->{documents});
128  print textfield('search');  print textfield('search');
129  print submit(-value=> x($config->{text}->{submit}));  print submit(-value=> x($config->{text}->{submit}));
130  print checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if ($spelling_alt);  print br,checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if (@spellings);
131    print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
132    if (@path_name) {
133            print br,x($config->{text}->{limit});
134            print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
135    } elsif (param('path')) {
136            print hidden(-name=>'path',-values=>param('path'));
137    }
138  print end_form,hr;  print end_form,hr;
139    
140  if (param('search')) {  if (param('search')) {
# Line 68  if (param('search')) { Line 150  if (param('search')) {
150          $search =~ s/^\s+//;          $search =~ s/^\s+//;
151          $search =~ s/\s+$//;          $search =~ s/\s+$//;
152    
153            my %words;
154    
155          foreach (split(/\s+/,$search)) {          foreach (split(/\s+/,$search)) {
156                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
157                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
158                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
159                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
160                                  my $w = $2; $w =~ s/[\*\s]+//g;                                  my $w = $2; $w =~ s/[\*\s]+//g;
161                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
162                                  $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";                                  my $or="";
163                                    foreach my $spelling_alt (@spellings) {
164                                            $s.="$or$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
165                                            $or = "or ";
166                                    }
167                          } else {                          } else {
168                                  $s.="$2* ";                                  $s.="$2* ";
169                          }                          }
170                  } else {                  } else {
171                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
172                                  my $w = $_; $w =~ s/[\*\s]+//g;                                  my $w = $_; $w =~ s/[\*\s]+//g;
173                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
174                                  $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  my $or="";
175                                    foreach my $spelling_alt (@spellings) {
176                                            $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
177                                            $or = "or ";
178                                    }
179                          } else {                          } else {
180                                  $s.="$_* ";                                  $s.="$_* ";
181                          }                          }
# Line 95  if (param('search')) { Line 187  if (param('search')) {
187          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
188          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
189    
190          my @properties = split(/\s+/,x($config->{properties}));          # limit to some path
191            $s = "swishdocpath=($path) and $s" if ($path);
192    
193            my %params;     # optional parametars for swish
194    
195            # default format for output
196            my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
197    
198            # output start of table
199            print qq{
200    <table border="0">
201            };
202            # html before and after each hit
203            my $tr_pre = qq{
204    <tr><td>
205            };
206            my $tr_post = qq{
207    </td></tr>
208            };
209    
210            if (@properties) {
211                    $hit_fmt = x($config->{hit}) if (! param('no_properties'));
212                    $params{properties} = \@properties;
213            } else {
214                    $hit_fmt = x($config->{hit}) if (x($config->{hit}));
215            }
216    
217            my $swish = SWISH::API->new($config->{index});
218            $swish->AbortLastError if $swish->Error;
219            my $results = $swish->Query($s);
220            my $hits = $results->Hits;
221    
222    
223            # build pager
224            my $current_page = param('page') || 1;
225    
226            my $pager = Data::Pageset->new({
227                    'total_entries' => $hits,
228                    'entries_per_page' => $max_hits,
229                    'current_page' => $current_page,
230                    'pages_per_set' => $pages_per_set,
231            });
232    
233            $results->SeekResult( $pager->first - 1 );
234    
235            # get number of entries on this page
236            my $i = $pager->entries_on_this_page;
237    
238            # print number of hits or error message
239            if ( !$hits ) {
240                    printf (x($config->{text}->{no_hits}),$s,$swish->ErrorString);
241            } else {
242                    printf (x($config->{text}->{hits}),$i,$results->Hits,$s);
243            }
244    
245            my %path2title;
246            use Data::Dumper;
247            foreach my $p (@{$config->{path2title}->{path}}) {
248                    $path2title{$p->{dir}} = $p->{content};
249            }
250    
251            for(my $i=$pager->first; $i<=$pager->last; $i++) {
252    
253          my $sh = SWISH->connect('Fork',                  my $result = $results->NextResult;
254                  prog     => x($config->{prog}),                  last if (! $result);
                 indexes  => x($config->{index}),  
                 properties  => \@properties,  
                 results  => sub {  
                         my ($sh,$hit) = @_;  
255    
256                          my $hit_fmt = x($config->{hit}) ||                  my @arr;
                                 "<a href=\"%s\">%s</a> [%s]<br>\n";  
257    
258                          if ($config->{url}) {                  foreach my $prop (@properties) {
259                                  printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);                          if ($prop =~ m/swishdescription/) {
260                                    my $tmp = get_snippet(
261                                            $result->Property($prop),
262                                            split(/\s+/,$search)
263                                    );
264                                    
265                                    push @arr, $tmp;
266                          } else {                          } else {
267                                  printf ($hit_fmt ,$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank, map($hit->$_, @properties) );                                  push @arr, $result->Property($prop);
268                            }
269                    }
270    
271                    my $title = e($result->Property("swishtitle")) || 'untitled';
272                    my $rank = $result->Property("swishrank");
273                    my $host = $result->Property("swishdocpath");
274                    $host = "http://".virtual_host().x($config->{url}).$result->Property("swishdocpath") if ($config->{url});
275    
276                    foreach my $p (keys %path2title) {
277                            if ($host =~ m/$p/i) {
278                                    $title =~ s/$path2title{$p}\s*[:-]+\s*//;
279                                    $title = $path2title{$p}." :: ".$title;
280                                    last;
281                          }                          }
282                    }
283    
284  #                       print $_[1]->as_string,"<br>\n";                  print $tr_pre,$i,". ";
285  #                       my @fields = $hit->field_names;                  # print collection name which is not link
286  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;                  if ($title =~ s/^(.+? :: )//) {
287                  },                          print $1;
288                  maxhits => param('max_hits') || $max_hits,                  }
         );  
289    
290          die $SWISH::errstr unless $sh;                  printf($hit_fmt, $host, $title || 'untitled', $rank, @arr);
291                    print $tr_post;
292    
293            }
294    
295          $hits = $sh->query($s);          # pager navigation
296            my $nav_html;
297    
298          if ($hits > 0) {          my $nav_fmt=qq{ <a href="%s">%s</a> };
299                  print p,hr;  
300                  printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);          if ($pager->current_page() > $pager->first_page) {
301          } else {                  param('page', $pager->current_page - 1);
302                  print p;                  $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&lt;&lt;');
303                  printf (x($config->{text}->{no_hits}),$s,$sh->errstr);          }
304    
305            if ($pager->previous_set) {
306                    param('page', $pager->previous_set);
307                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
308          }          }
309    
310    
311            foreach my $p (@{$pager->pages_in_set()}) {
312                    next if ($p < 0);
313    #       for (my $p=$pager->previous_set; $p <= $pager->next_set; $p++) {
314                    if($p == $pager->current_page()) {
315                            $nav_html .= "<b>$p</b> ";
316                    } else {
317                            param('page', $p);
318                            $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),$p);
319                    }
320            }
321    
322            if ($pager->next_set) {
323                    param('page', $pager->next_set);
324                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
325            }
326    
327            if ($pager->current_page() < $pager->last_page) {
328                    param('page', $pager->current_page + 1);
329                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&gt;&gt;');
330            }
331    
332            if ($config->{text}->{pages}) {
333                    $nav_html = x($config->{text}->{pages})." ".$nav_html;
334            }
335    
336            # end html table
337            print qq{
338    <tr><td>
339    $nav_html
340    </td></tr>
341    </table>
342            };
343    
344    
345    
346  } else {  } else {
347          print p(x($config->{text}->{footer}));          print p(x($config->{text}->{footer}));
348  }  }
Legend:
Removed from v.21  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.26