/[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 32 by dpavlin, Wed Apr 30 12:40:09 2003 UTC revision 59 by dpavlin, Mon Jan 26 08:08:41 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    # for pager
13    my $pages_per_set = 20;
14    
15  Text::Iconv->raise_error(0);     # Conversion errors raise exceptions  Text::Iconv->raise_error(0);     # Conversion errors raise exceptions
16  my $config=XMLin(undef,  my $config=XMLin(undef,
# Line 31  sub e { Line 35  sub e {
35          return $out;          return $out;
36  }  }
37    
38  my $spelling_alt;  my @spellings;
39  # FIX: doesn't work very well  # FIX: doesn't work very well
40  if ($config->{findaffix}) {  if ($config->{findaffix}) {
41          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $findaffix (split(/[, ]+/,x($config->{findaffix}))) {
42          $spelling_alt->load_findaffix(x($config->{findaffix}));                  my $spelling_alt = new Lingua::Spelling::Alternative;
43                    $spelling_alt->load_findaffix($findaffix);
44                    push @spellings,$spelling_alt;
45            }
46  }  }
47  if ($config->{affix}) {  if ($config->{affix}) {
48          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $affix (split(/[, ]+/,x($config->{affix}))) {
49          $spelling_alt->load_affix(x($config->{affix}));                  my $spelling_alt = new Lingua::Spelling::Alternative;
50                    $spelling_alt->load_affix($affix);
51                    push @spellings,$spelling_alt;
52            }
53  }  }
54    
55  my $hits=0;  my $hits=0;
56  my $max_hits=x($config->{max_hits});  my $max_hits=param('max_hits') || x($config->{max_hits});
57    
58  my %labels;  my %labels;
59  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
60            next if (! $_->{value});        # skip unlimited (0)
61          $labels{$_->{value}} = x($_->{content});          $labels{$_->{value}} = x($_->{content});
62  }  }
63    
# Line 54  my $path = param('path');      # limit to thi Line 65  my $path = param('path');      # limit to thi
65  my %path_label;  my %path_label;
66  my @path_name;  my @path_name;
67  foreach (@{$config->{paths}->{path}}) {  foreach (@{$config->{paths}->{path}}) {
68    
69    print STDERR "##: $_->{limit}",x($_->{content}),"\n";
70          push @path_name,x($_->{limit});          push @path_name,x($_->{limit});
71          $path_label{$_->{limit}} = x($_->{content});          $path_label{$_->{limit}} = x($_->{content});
72  }  }
# Line 71  print popup_menu(-name=>'max_hits',-valu Line 84  print popup_menu(-name=>'max_hits',-valu
84  print x($config->{text}->{documents});  print x($config->{text}->{documents});
85  print textfield('search');  print textfield('search');
86  print submit(-value=> x($config->{text}->{submit}));  print submit(-value=> x($config->{text}->{submit}));
87  print br,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);
88  print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);  print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
89  if (@path_name) {  if (@path_name) {
90          print br,x($config->{text}->{limit});          print br,x($config->{text}->{limit});
# Line 92  if (param('search')) { Line 105  if (param('search')) {
105          $search =~ s/^\s+//;          $search =~ s/^\s+//;
106          $search =~ s/\s+$//;          $search =~ s/\s+$//;
107    
108            my %words;
109    
110          foreach (split(/\s+/,$search)) {          foreach (split(/\s+/,$search)) {
111                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
112                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
113                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
114                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
115                                  my $w = $2; $w =~ s/[\*\s]+//g;                                  my $w = $2; $w =~ s/[\*\s]+//g;
116                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
117                                  $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";                                  my $or="";
118                                    foreach my $spelling_alt (@spellings) {
119                                            $s.="$or$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
120                                            $or = "or ";
121                                    }
122                          } else {                          } else {
123                                  $s.="$2* ";                                  $s.="$2* ";
124                          }                          }
125                  } else {                  } else {
126                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
127                                  my $w = $_; $w =~ s/[\*\s]+//g;                                  my $w = $_; $w =~ s/[\*\s]+//g;
128                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
129                                  $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  my $or="";
130                                    foreach my $spelling_alt (@spellings) {
131                                            $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
132                                            $or = "or ";
133                                    }
134                          } else {                          } else {
135                                  $s.="$_* ";                                  $s.="$_* ";
136                          }                          }
# Line 120  if (param('search')) { Line 143  if (param('search')) {
143          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
144    
145          # limit to some path          # limit to some path
146          $s = "swishdocpath=(\"$path\") and $s" if ($path);          $s = "swishdocpath=(\"*$path*\") and $s" if ($path);
147    
148          my %params;     # optional parametars for swish          my %params;     # optional parametars for swish
149    
150          # default format for output          # default format for output
151          my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";          my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
152    
153            # output start of table
154            print qq{
155    <table border="0">
156            };
157            # html before and after each hit
158            my $tr_pre = qq{
159    <tr><td>
160            };
161            my $tr_post = qq{
162    </td></tr>
163            };
164    
165          if (@properties) {          if (@properties) {
166                  $hit_fmt = x($config->{hit}) if (! param('no_properties'));                  $hit_fmt = x($config->{hit}) if (! param('no_properties'));
167                  $params{properties} = \@properties if (@properties);                  $params{properties} = \@properties;
168          } else {          } else {
169                  $hit_fmt = x($config->{hit}) if (x($config->{hit}));                  $hit_fmt = x($config->{hit}) if (x($config->{hit}));
170          }          }
171    
172          my $sh = SWISH->connect('Fork',  #       my $sh = SWISH->connect('Fork',
173                  prog     => x($config->{prog}),  #               prog     => x($config->{prog}),
174                  indexes  => x($config->{index}),  #               indexes  => x($config->{index}),
175                  results  => sub {  #               results  => sub {
176                          my ($sh,$hit) = @_;  #                       my ($sh,$hit) = @_;
177    #
178    #                       if ($config->{url}) {
179    #                               printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties));
180    #                       } else {
181    #                               printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
182    #
183    #                       }
184    #
185    ##                      print $_[1]->as_string,"<br>\n";
186    ##                      my @fields = $hit->field_names;
187    ##                      print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
188    #               },
189    #               maxhits => param('max_hits') || $max_hits,
190    #               \%params,
191    #       );
192    #
193    #       die $SWISH::errstr unless $sh;
194    #
195    #       $hits = $sh->query($s);
196    #
197    #       if ($hits && $hits > 0) {
198    #               print p,hr;
199    #               printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
200    #       } else {
201    #               print p;
202    #               printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
203    #       }
204    #       if ($hits && $hits > 0) {
205    #               print p,hr;
206    #               printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
207    #       } else {
208    #               print p;
209    #               printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
210    #       }
211    
212            my $swish = SWISH::API->new($config->{index});
213    
214            $swish->AbortLastError if $swish->Error;
215    
216            my $results = $swish->Query($s);
217    
218            my $hits = $results->Hits;
219    
220    
221    
222            # build pager
223            my $current_page = param('page') || 1;
224    
225            my $pager = Data::Pageset->new({
226                    'total_entries' => $hits,
227                    'entries_per_page' => $max_hits,
228                    'current_page' => $current_page,
229                    'pages_per_set' => $pages_per_set,
230            });
231    
232            $results->SeekResult( $pager->first - 1 );
233    
234            # get number of entries on this page
235            my $i = $pager->entries_on_this_page;
236    
237            # print number of hits or error message
238            if ( !$hits ) {
239                    printf (x($config->{text}->{no_hits}),$s,$swish->ErrorString);
240            } else {
241                    printf (x($config->{text}->{hits}),$i,$results->Hits,$s);
242            }
243    
                         if ($config->{url}) {  
                                 printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties));  
                         } else {  
                                 printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );  
244    
245            for(my $i=$pager->first; $i<=$pager->last; $i++) {
246    
247                    my $result = $results->NextResult;
248                    last if (! $result);
249    
250                    my @arr;
251                    foreach my $prop (@properties) {
252                            if ($prop =~ m/swishdescription/) {
253                                    my $tmp = $result->Property($prop);
254                                    $tmp =~ s/<[^>]+>//g;
255                                    push @arr, $tmp;
256                            } else {
257                                    push @arr, $result->Property($prop);
258                          }                          }
259                    }
260    
261  #                       print $_[1]->as_string,"<br>\n";                  print $tr_pre,$i,". ";
262  #                       my @fields = $hit->field_names;                  if ($config->{url}) {
263  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;                          printf($hit_fmt, "http://".virtual_host().x($config->{url}).$result->Property("swishdocpath"),
264                  },                                  e($result->Property("swishtitle")) || 'untitled',
265                  maxhits => param('max_hits') || $max_hits,                                  $result->Property("swishrank"),
266                  \%params,                                  @arr);
267          );                  } else {
268                            printf($hit_fmt, $result->Property("swishdocpath"),
269                                    e($result->Property("swishtitle")) || 'untitled',
270                                    $result->Property("swishrank"),
271                                    @arr);
272                    }
273                    print $tr_post;
274    
275          die $SWISH::errstr unless $sh;          }
276    
277            # pager navigation
278            my $nav_html;
279    
280          $hits = $sh->query($s);          my $nav_fmt=qq{ <a href="%s">%s</a> };
281    
282          if ($hits > 0) {          if ($pager->previous_set) {
283                  print p,hr;                  param('page', $pager->previous_set);
284                  printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);                  $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&lt;&lt;');
285          } else {          }
286                  print p;  
287                  printf (x($config->{text}->{no_hits}),$s,$sh->errstr);  
288            foreach my $p (@{$pager->pages_in_set()}) {
289    #       for (my $p=$pager->previous_set; $p <= $pager->next_set; $p++) {
290                    if($p == $pager->current_page()) {
291                            $nav_html .= "<b>$p</b> ";
292                    } else {
293                            param('page', $p);
294                            $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),$p);
295                    }
296            }
297    
298            if ($pager->next_set) {
299                    param('page', $pager->next_set);
300                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&gt;&gt;');
301          }          }
302    
303            # end html table
304            print qq{
305    <tr><td>
306    Pages: $nav_html
307    </td></tr>
308    </table>
309            };
310    
311    
312    
313  } else {  } else {
314          print p(x($config->{text}->{footer}));          print p(x($config->{text}->{footer}));
315  }  }
Legend:
Removed from v.32  
changed lines
  Added in v.59
  ViewVC Help
Powered by ViewVC 1.1.26