/[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 8 by dpavlin, Sun Mar 16 21:06:43 2003 UTC revision 76 by dpavlin, Sat Apr 17 18:41:21 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          );          );
20    
21  use Data::Dumper;  my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
22  #print Dumper($config);  sub x {
23            return if (! defined $_[0]);
24            return $from_utf8->convert($_[0]);
25    }
26    
27  my $spelling_alt;  # Escape <, >, & and ", and to produce valid XML
28    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
29    my $escape_re  = join '|' => keys %escape;
30    sub e {
31            my $out;
32            foreach my $v (@_) {
33                    $v =~ s/($escape_re)/$escape{$1}/g;
34                    $out .= $v;
35            }
36            return $out;
37    }
38    
39    my @spellings;
40  # FIX: doesn't work very well  # FIX: doesn't work very well
41    if ($config->{findaffix}) {
42            foreach my $findaffix (split(/[, ]+/,x($config->{findaffix}))) {
43                    my $spelling_alt = new Lingua::Spelling::Alternative;
44                    $spelling_alt->load_findaffix($findaffix);
45                    push @spellings,$spelling_alt;
46            }
47    }
48  if ($config->{affix}) {  if ($config->{affix}) {
49          $spelling_alt = new Lingua::Spelling::Alternative;          foreach my $affix (split(/[, ]+/,x($config->{affix}))) {
50          $spelling_alt->load_findaffix($config->{affix});                  my $spelling_alt = new Lingua::Spelling::Alternative;
51                    $spelling_alt->load_affix($affix);
52                    push @spellings,$spelling_alt;
53            }
54  }  }
55    
56  my $hits=0;  my $hits=0;
57  my $max_hits=$config->{max_hits};  my $max_hits=param('max_hits') || x($config->{max_hits});
58    
59  my %labels;  my %labels;
60  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
61          $labels{$_->{value}} = $from_utf8->convert($_->{content});          next if (! $_->{value});        # skip unlimited (0)
62            $labels{$_->{value}} = x($_->{content});
63    }
64    
65    my $path = param('path');       # limit to this path
66    my %path_label;
67    my @path_name;
68    foreach (@{$config->{paths}->{path}}) {
69    
70    print STDERR "##: $_->{limit}",x($_->{content}),"\n";
71            push @path_name,x($_->{limit});
72            $path_label{$_->{limit}} = x($_->{content});
73  }  }
74    
75  print header(-charset=>$CHARSET),start_html(-title=>'Pretrazivanje',-lang=>'hr'),start_form;  my @properties = split(/\s+/,x($config->{properties})) if ($config->{properties});
76  print "Potra¾i ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," dokumenata sa riječima: ",textfield('search');  
77  print submit(-value=>'prika¾i');  if ($config->{charset}) {
78  print checkbox(-name=>'no_affix', -checked=>0, -label=>'ne koristi variranje oblika riječi');          print header(-charset=>x($config->{charset}));
79    } else {
80            print header;
81    }
82    print start_html(-title=>x($config->{title})),start_form;
83    print x($config->{text}->{search});
84    print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
85    print x($config->{text}->{documents});
86    print textfield('search');
87    print submit(-value=> x($config->{text}->{submit}));
88    print br,checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if (@spellings);
89    print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
90    if (@path_name) {
91            print br,x($config->{text}->{limit});
92            print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
93    }
94  print end_form,hr;  print end_form,hr;
95    
96  if (param('search')) {  if (param('search')) {
# Line 56  if (param('search')) { Line 106  if (param('search')) {
106          $search =~ s/^\s+//;          $search =~ s/^\s+//;
107          $search =~ s/\s+$//;          $search =~ s/\s+$//;
108    
109            my %words;
110    
111          foreach (split(/\s+/,$search)) {          foreach (split(/\s+/,$search)) {
112                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
113                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
114                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
115                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
116                                  my $w = $2; $w =~ s/[\*\s]+//g;                                  my $w = $2; $w =~ s/[\*\s]+//g;
117                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
118                                  $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";                                  my $or="";
119                                    foreach my $spelling_alt (@spellings) {
120                                            $s.="$or$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
121                                            $or = "or ";
122                                    }
123                          } else {                          } else {
124                                  $s.="$2* ";                                  $s.="$2* ";
125                          }                          }
126                  } else {                  } else {
127                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
128                                  my $w = $_; $w =~ s/[\*\s]+//g;                                  my $w = $_; $w =~ s/[\*\s]+//g;
129                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
130                                  $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  my $or="";
131                                    foreach my $spelling_alt (@spellings) {
132                                            $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
133                                            $or = "or ";
134                                    }
135                          } else {                          } else {
136                                  $s.="$_* ";                                  $s.="$_* ";
137                          }                          }
# Line 83  if (param('search')) { Line 143  if (param('search')) {
143          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;
144          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
145    
146          my $sh = SWISH->connect('Fork',          # limit to some path
147                  prog     => $config->{prog},          $s = "swishdocpath=(\"*$path*\") and $s" if ($path);
                 indexes  => $config->{index},  
 #               properties  => [qw/god br nr/],  
                 results  => sub {  
                         my ($sh,$hit) = @_;  
   
                         print "<a href=\"",$hit->swishdocpath,"\">",$hit->swishtitle,"</a> [",$hit->swishrank,"]<br>\n";  
   
 #                       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,  
         );  
148    
149          die $SWISH::errstr unless $sh;          my %params;     # optional parametars for swish
150    
151            # default format for output
152            my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
153    
154          $hits = $sh->query($s);          # output start of table
155            print qq{
156    <table border="0">
157            };
158            # html before and after each hit
159            my $tr_pre = qq{
160    <tr><td>
161            };
162            my $tr_post = qq{
163    </td></tr>
164            };
165    
166            if (@properties) {
167                    $hit_fmt = x($config->{hit}) if (! param('no_properties'));
168                    $params{properties} = \@properties;
169            } else {
170                    $hit_fmt = x($config->{hit}) if (x($config->{hit}));
171            }
172    
173          if ($hits > 0) {  #       my $sh = SWISH->connect('Fork',
174                  print p,hr,"Prikazujem $hits dokumenata (maks. ",param('max_hits') || $max_hits,")... <small>($s)</small>";  #               prog     => x($config->{prog}),
175    #               indexes  => x($config->{index}),
176    #               results  => sub {
177    #                       my ($sh,$hit) = @_;
178    #
179    #                       if ($config->{url}) {
180    #                               printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties));
181    #                       } else {
182    #                               printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
183    #
184    #                       }
185    #
186    ##                      print $_[1]->as_string,"<br>\n";
187    ##                      my @fields = $hit->field_names;
188    ##                      print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
189    #               },
190    #               maxhits => param('max_hits') || $max_hits,
191    #               \%params,
192    #       );
193    #
194    #       die $SWISH::errstr unless $sh;
195    #
196    #       $hits = $sh->query($s);
197    #
198    #       if ($hits && $hits > 0) {
199    #               print p,hr;
200    #               printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
201    #       } else {
202    #               print p;
203    #               printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
204    #       }
205    #       if ($hits && $hits > 0) {
206    #               print p,hr;
207    #               printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
208    #       } else {
209    #               print p;
210    #               printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
211    #       }
212    
213            my $swish = SWISH::API->new($config->{index});
214    
215            $swish->AbortLastError if $swish->Error;
216    
217            my $results = $swish->Query($s);
218    
219            my $hits = $results->Hits;
220    
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 {          } else {
242                  print p,"Nije našen niti jedan dokument... <small>($s, ",$sh->errstr,")</small>";                  printf (x($config->{text}->{hits}),$i,$results->Hits,$s);
243            }
244    
245    
246            for(my $i=$pager->first; $i<=$pager->last; $i++) {
247    
248                    my $result = $results->NextResult;
249                    last if (! $result);
250    
251                    my @arr;
252                    foreach my $prop (@properties) {
253                            if ($prop =~ m/swishdescription/) {
254                                    my $tmp = $result->Property($prop);
255                                    $tmp =~ s/<[^>]+>//g;
256                                    push @arr, $tmp;
257                            } else {
258                                    push @arr, $result->Property($prop);
259                            }
260                    }
261    
262                    my $title = e($result->Property("swishtitle")) || 'untitled';
263                    my $rank = $result->Property("swishrank");
264                    my $host = $result->Property("swishdocpath");
265                    $host = "http://".virtual_host().x($config->{url}).$result->Property("swishdocpath") if ($config->{url});
266                    print $tr_pre,$i,". ";
267                    # print collection name which is not link
268                    if ($title =~ s/^(.+? :: )//) {
269                            print $1;
270                    }
271                    printf($hit_fmt, $host, $title || 'untitled', $rank, @arr);
272                    print $tr_post;
273    
274          }          }
275    
276            # pager navigation
277            my $nav_html;
278    
279            my $nav_fmt=qq{ <a href="%s">%s</a> };
280    
281            if ($pager->current_page() > $pager->first_page) {
282                    param('page', $pager->current_page - 1);
283                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&lt;&lt;');
284            }
285    
286            if ($pager->previous_set) {
287                    param('page', $pager->previous_set);
288                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
289            }
290    
291    
292            foreach my $p (@{$pager->pages_in_set()}) {
293                    next if ($p < 0);
294    #       for (my $p=$pager->previous_set; $p <= $pager->next_set; $p++) {
295                    if($p == $pager->current_page()) {
296                            $nav_html .= "<b>$p</b> ";
297                    } else {
298                            param('page', $p);
299                            $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),$p);
300                    }
301            }
302    
303            if ($pager->next_set) {
304                    param('page', $pager->next_set);
305                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'..');
306            }
307    
308            if ($pager->current_page() < $pager->last_page) {
309                    param('page', $pager->current_page + 1);
310                    $nav_html .= sprintf($nav_fmt,url(-relative=>1, -query=>1),'&gt;&gt;');
311            }
312    
313            if ($config->{text}->{pages}) {
314                    $nav_html = x($config->{text}->{pages})." ".$nav_html;
315            }
316    
317            # end html table
318            print qq{
319    <tr><td>
320    $nav_html
321    </td></tr>
322    </table>
323            };
324    
325    
326    
327  } else {  } else {
328          print p('Kod pretra¾ivanja pretra¾ivač pronalazi sve dokumente u kojima se pojavljuju <b>sve upisanje riječi</b>.',br,'Ako ispred riječi upi¹ete minus (-) neęe se prikazivati dokumenti koji imaju takvu riječ. Npr. <tt>+mreza -novak</tt>');          print p(x($config->{text}->{footer}));
329  }  }
Legend:
Removed from v.8  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.26