/[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

Contents of /trunk/html/swish.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 59 - (show annotations)
Mon Jan 26 08:08:41 2004 UTC (20 years, 2 months ago) by dpavlin
File size: 7780 byte(s)
implemented usage of SWISH::API instead of SWISH::Fork, new pages
using Data::Pageset

1 #!/usr/bin/perl -w
2
3 use strict;
4 use CGI qw/:standard -no_xhtml/;
5 use CGI::Carp qw(fatalsToBrowser);
6 use SWISH::API;
7 use XML::Simple;
8 use Lingua::Spelling::Alternative;
9 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
16 my $config=XMLin(undef,
17 # keyattr => { label => "value" },
18 forcecontent => 0,
19 );
20
21 my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
22 sub x {
23 return $from_utf8->convert($_[0]);
24 }
25
26 # Escape <, >, & and ", and to produce valid XML
27 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
28 my $escape_re = join '|' => keys %escape;
29 sub e {
30 my $out;
31 foreach my $v (@_) {
32 $v =~ s/($escape_re)/$escape{$1}/g;
33 $out .= $v;
34 }
35 return $out;
36 }
37
38 my @spellings;
39 # FIX: doesn't work very well
40 if ($config->{findaffix}) {
41 foreach my $findaffix (split(/[, ]+/,x($config->{findaffix}))) {
42 my $spelling_alt = new Lingua::Spelling::Alternative;
43 $spelling_alt->load_findaffix($findaffix);
44 push @spellings,$spelling_alt;
45 }
46 }
47 if ($config->{affix}) {
48 foreach my $affix (split(/[, ]+/,x($config->{affix}))) {
49 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;
56 my $max_hits=param('max_hits') || x($config->{max_hits});
57
58 my %labels;
59 foreach (@{$config->{labels}->{label}}) {
60 next if (! $_->{value}); # skip unlimited (0)
61 $labels{$_->{value}} = x($_->{content});
62 }
63
64 my $path = param('path'); # limit to this path
65 my %path_label;
66 my @path_name;
67 foreach (@{$config->{paths}->{path}}) {
68
69 print STDERR "##: $_->{limit}",x($_->{content}),"\n";
70 push @path_name,x($_->{limit});
71 $path_label{$_->{limit}} = x($_->{content});
72 }
73
74 my @properties = split(/\s+/,x($config->{properties}));
75
76 if ($config->{charset}) {
77 print header(-charset=>x($config->{charset}));
78 } else {
79 print header;
80 }
81 print start_html(-title=>x($config->{title})),start_form;
82 print x($config->{text}->{search});
83 print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
84 print x($config->{text}->{documents});
85 print textfield('search');
86 print submit(-value=> x($config->{text}->{submit}));
87 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);
89 if (@path_name) {
90 print br,x($config->{text}->{limit});
91 print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
92 }
93 print end_form,hr;
94
95 if (param('search')) {
96
97 my $s;
98 # re-write query from +/- to and/and not
99
100 my $search = param('search');
101 my $s_phrase = "";
102 while ($search =~ s/\s*("[^"]+")\s*/ /) {
103 $s .= "$1 ";
104 }
105 $search =~ s/^\s+//;
106 $search =~ s/\s+$//;
107
108 my %words;
109
110 foreach (split(/\s+/,$search)) {
111 if (m/^([+-])(\S+)/) {
112 $s.= ($s) ? "and " : "";
113 $s.="not " if ($1 eq "-");
114 if (@spellings && !param('no_affix')) {
115 my $w = $2; $w =~ s/[\*\s]+//g;
116 $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
117 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 {
123 $s.="$2* ";
124 }
125 } else {
126 if (@spellings && !param('no_affix')) {
127 my $w = $_; $w =~ s/[\*\s]+//g;
128 #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
129 my $or="";
130 foreach my $spelling_alt (@spellings) {
131 $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
132 $or = "or ";
133 }
134 } else {
135 $s.="$_* ";
136 }
137 }
138 }
139
140 # fixup search string
141 $s=~tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
142 $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
143 $s=~s/\*\*+/*/g;
144
145 # limit to some path
146 $s = "swishdocpath=(\"*$path*\") and $s" if ($path);
147
148 my %params; # optional parametars for swish
149
150 # default format for output
151 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) {
166 $hit_fmt = x($config->{hit}) if (! param('no_properties'));
167 $params{properties} = \@properties;
168 } else {
169 $hit_fmt = x($config->{hit}) if (x($config->{hit}));
170 }
171
172 # my $sh = SWISH->connect('Fork',
173 # prog => x($config->{prog}),
174 # indexes => x($config->{index}),
175 # results => sub {
176 # 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
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 $tr_pre,$i,". ";
262 if ($config->{url}) {
263 printf($hit_fmt, "http://".virtual_host().x($config->{url}).$result->Property("swishdocpath"),
264 e($result->Property("swishtitle")) || 'untitled',
265 $result->Property("swishrank"),
266 @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 }
276
277 # pager navigation
278 my $nav_html;
279
280 my $nav_fmt=qq{ <a href="%s">%s</a> };
281
282 if ($pager->previous_set) {
283 param('page', $pager->previous_set);
284 $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&lt;&lt;');
285 }
286
287
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 {
314 print p(x($config->{text}->{footer}));
315 }

Properties

Name Value
cvs2svn:cvs-rev 1.14
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26