/[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 16 by dpavlin, Sun Mar 16 21:44:42 2003 UTC revision 80 by dpavlin, Sat May 22 18:33:33 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  # output charset  # for pager
13  my $CHARSET='ISO-8859-2';  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
 my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);  
   
16  my $config=XMLin(undef,  my $config=XMLin(undef,
17  #               keyattr => { label => "value" },  #               keyattr => { label => "value" },
18                  forcecontent => 0,                  forcecontent => 0,
19                    ForceArray => [ 'path' ],
20          );          );
21    
22  use Data::Dumper;  my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
23  #print Dumper($config);  sub x {
24            return if (! defined $_[0]);
25            return $from_utf8->convert($_[0]);
26    }
27    
28  my $spelling_alt;  # Escape <, >, & and ", and to produce valid XML
29    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
30    my $escape_re  = join '|' => keys %escape;
31    sub e {
32            my $out;
33            foreach my $v (@_) {
34                    $v =~ s/($escape_re)/$escape{$1}/g;
35                    $out .= $v;
36            }
37            return $out;
38    }
39    
40    my @spellings;
41  # FIX: doesn't work very well  # FIX: doesn't work very well
42  if ($config->{findaffix}) {  if ($config->{findaffix}) {
43          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $findaffix (split(/[, ]+/,x($config->{findaffix}))) {
44          $spelling_alt->load_findaffix($config->{affix});                  next if (! -f $findaffix);
45                    my $spelling_alt = new Lingua::Spelling::Alternative;
46                    $spelling_alt->load_findaffix($findaffix);
47                    push @spellings,$spelling_alt;
48            }
49  }  }
50  if ($config->{affix}) {  if ($config->{affix}) {
51          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $affix (split(/[, ]+/,x($config->{affix}))) {
52          $spelling_alt->load_affix($config->{affix});                  next if (! -f $affix);
53                    my $spelling_alt = new Lingua::Spelling::Alternative;
54                    $spelling_alt->load_affix($affix);
55                    push @spellings,$spelling_alt;
56            }
57  }  }
58    
59  my $hits=0;  my $hits=0;
60  my $max_hits=$config->{max_hits};  my $max_hits=param('max_hits') || x($config->{max_hits});
61    
62  my %labels;  my %labels;
63  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
64          $labels{$_->{value}} = $from_utf8->convert($_->{content});          next if (! $_->{value});        # skip unlimited (0)
65            $labels{$_->{value}} = x($_->{content});
66  }  }
67    
68    my $path = param('path');       # limit to this path
69    my %path_label;
70    my @path_name;
71    foreach (@{$config->{paths}->{path}}) {
72    
73    print STDERR "##: $_->{limit}",x($_->{content}),"\n";
74            push @path_name,x($_->{limit});
75            $path_label{$_->{limit}} = x($_->{content});
76    }
77    
78    my @properties = split(/\s+/,x($config->{properties})) if ($config->{properties});
79    
80  if ($config->{charset}) {  if ($config->{charset}) {
81          print header(-charset=>$config->{charset});          print header(-charset=>x($config->{charset}));
82  } else {  } else {
83          print header;          print header;
84  }  }
85  print start_html(-title=>$config->{title}),start_form;  print start_html(-title=>x($config->{title})),start_form;
86  print $config->{text}->{search};  print x($config->{text}->{search});
87  print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);  print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
88  print $config->{text}->{documents};  print x($config->{text}->{documents});
89  print textfield('search');  print textfield('search');
90  print submit(-value=> $config->{text}->{submit});  print submit(-value=> x($config->{text}->{submit}));
91  print checkbox(-name=>'no_affix', -checked=>0, -label=>$config->{text}->{no_spell}) if ($spelling_alt);  print br,checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if (@spellings);
92    print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
93    if (@path_name) {
94            print br,x($config->{text}->{limit});
95            print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
96    }
97  print end_form,hr;  print end_form,hr;
98    
99  if (param('search')) {  if (param('search')) {
# Line 68  if (param('search')) { Line 109  if (param('search')) {
109          $search =~ s/^\s+//;          $search =~ s/^\s+//;
110          $search =~ s/\s+$//;          $search =~ s/\s+$//;
111    
112            my %words;
113    
114          foreach (split(/\s+/,$search)) {          foreach (split(/\s+/,$search)) {
115                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
116                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
117                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
118                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
119                                  my $w = $2; $w =~ s/[\*\s]+//g;                                  my $w = $2; $w =~ s/[\*\s]+//g;
120                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
121                                  $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";                                  my $or="";
122                                    foreach my $spelling_alt (@spellings) {
123                                            $s.="$or$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
124                                            $or = "or ";
125                                    }
126                          } else {                          } else {
127                                  $s.="$2* ";                                  $s.="$2* ";
128                          }                          }
129                  } else {                  } else {
130                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
131                                  my $w = $_; $w =~ s/[\*\s]+//g;                                  my $w = $_; $w =~ s/[\*\s]+//g;
132                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
133                                  $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  my $or="";
134                                    foreach my $spelling_alt (@spellings) {
135                                            $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
136                                            $or = "or ";
137                                    }
138                          } else {                          } else {
139                                  $s.="$_* ";                                  $s.="$_* ";
140                          }                          }
# Line 95  if (param('search')) { Line 146  if (param('search')) {
146          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
147          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
148    
149          my $sh = SWISH->connect('Fork',          # limit to some path
150                  prog     => $config->{prog},          $s = "swishdocpath=(\"*$path*\") and $s" if ($path);
                 indexes  => $config->{index},  
 #               properties  => [qw/god br nr/],  
                 results  => sub {  
                         my ($sh,$hit) = @_;  
   
                         printf ("<a href=\"%s\">%s</a> [%s]<br>\n","http://".virtual_host().$config->{url}.$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);  
   
 #                       print $_[1]->as_string,"<br>\n";  
 #                       my @fields = $hit->field_names;  
 #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;  
                 },  
                 maxhits => param('max_hits') || $max_hits,  
         );  
151    
152          die $SWISH::errstr unless $sh;          my %params;     # optional parametars for swish
153    
154            # default format for output
155            my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
156    
157          $hits = $sh->query($s);          # output start of table
158            print qq{
159    <table border="0">
160            };
161            # html before and after each hit
162            my $tr_pre = qq{
163    <tr><td>
164            };
165            my $tr_post = qq{
166    </td></tr>
167            };
168    
169            if (@properties) {
170                    $hit_fmt = x($config->{hit}) if (! param('no_properties'));
171                    $params{properties} = \@properties;
172            } else {
173                    $hit_fmt = x($config->{hit}) if (x($config->{hit}));
174            }
175    
176          if ($hits > 0) {          my $swish = SWISH::API->new($config->{index});
177                  print p,hr;          $swish->AbortLastError if $swish->Error;
178                  printf ($config->{text}->{hits},$hits,param('max_hits') || $max_hits,$s);          my $results = $swish->Query($s);
179            my $hits = $results->Hits;
180    
181    
182            # build pager
183            my $current_page = param('page') || 1;
184    
185            my $pager = Data::Pageset->new({
186                    'total_entries' => $hits,
187                    'entries_per_page' => $max_hits,
188                    'current_page' => $current_page,
189                    'pages_per_set' => $pages_per_set,
190            });
191    
192            $results->SeekResult( $pager->first - 1 );
193    
194            # get number of entries on this page
195            my $i = $pager->entries_on_this_page;
196    
197            # print number of hits or error message
198            if ( !$hits ) {
199                    printf (x($config->{text}->{no_hits}),$s,$swish->ErrorString);
200          } else {          } else {
201                  print p;                  printf (x($config->{text}->{hits}),$i,$results->Hits,$s);
202                  printf ($config->{text}->{no_hits},$s,$sh->errstr);          }
203    
204            my %path2title;
205            use Data::Dumper;
206            foreach my $p (@{$config->{path2title}->{path}}) {
207                    $path2title{$p->{dir}} = $p->{content};
208            }
209    
210            for(my $i=$pager->first; $i<=$pager->last; $i++) {
211    
212                    my $result = $results->NextResult;
213                    last if (! $result);
214    
215                    my @arr;
216                    foreach my $prop (@properties) {
217                            if ($prop =~ m/swishdescription/) {
218                                    my $tmp = $result->Property($prop);
219                                    $tmp =~ s/<[^>]+>//g;
220                                    push @arr, $tmp;
221                            } else {
222                                    push @arr, $result->Property($prop);
223                            }
224                    }
225    
226                    my $title = e($result->Property("swishtitle")) || 'untitled';
227                    my $rank = $result->Property("swishrank");
228                    my $host = $result->Property("swishdocpath");
229                    $host = "http://".virtual_host().x($config->{url}).$result->Property("swishdocpath") if ($config->{url});
230    
231                    foreach my $p (keys %path2title) {
232                            if ($host =~ m/$p/i) {
233                                    $title =~ s/$path2title{$p}\s*[:-]+\s*//;
234                                    $title = $path2title{$p}." :: ".$title;
235                                    last;
236                            }
237                    }
238    
239                    print $tr_pre,$i,". ";
240                    # print collection name which is not link
241                    if ($title =~ s/^(.+? :: )//) {
242                            print $1;
243                    }
244    
245                    printf($hit_fmt, $host, $title || 'untitled', $rank, @arr);
246                    print $tr_post;
247    
248            }
249    
250            # pager navigation
251            my $nav_html;
252    
253            my $nav_fmt=qq{ <a href="%s">%s</a> };
254    
255            if ($pager->current_page() > $pager->first_page) {
256                    param('page', $pager->current_page - 1);
257                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&lt;&lt;');
258            }
259    
260            if ($pager->previous_set) {
261                    param('page', $pager->previous_set);
262                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
263            }
264    
265    
266            foreach my $p (@{$pager->pages_in_set()}) {
267                    next if ($p < 0);
268    #       for (my $p=$pager->previous_set; $p <= $pager->next_set; $p++) {
269                    if($p == $pager->current_page()) {
270                            $nav_html .= "<b>$p</b> ";
271                    } else {
272                            param('page', $p);
273                            $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),$p);
274                    }
275            }
276    
277            if ($pager->next_set) {
278                    param('page', $pager->next_set);
279                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
280            }
281    
282            if ($pager->current_page() < $pager->last_page) {
283                    param('page', $pager->current_page + 1);
284                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&gt;&gt;');
285          }          }
286    
287            if ($config->{text}->{pages}) {
288                    $nav_html = x($config->{text}->{pages})." ".$nav_html;
289            }
290    
291            # end html table
292            print qq{
293    <tr><td>
294    $nav_html
295    </td></tr>
296    </table>
297            };
298    
299    
300    
301  } else {  } else {
302          print p($config->{text}->{footer});          print p(x($config->{text}->{footer}));
303  }  }
Legend:
Removed from v.16  
changed lines
  Added in v.80
  ViewVC Help
Powered by ViewVC 1.1.26