/[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 32 by dpavlin, Wed Apr 30 12:40:09 2003 UTC
# Line 8  use XML::Simple; Line 8  use XML::Simple;
8  use Lingua::Spelling::Alternative;  use Lingua::Spelling::Alternative;
9  use Text::Iconv;  use Text::Iconv;
10    
 # output charset  
 my $CHARSET='ISO-8859-2';  
   
11  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);  
   
12  my $config=XMLin(undef,  my $config=XMLin(undef,
13  #               keyattr => { label => "value" },  #               keyattr => { label => "value" },
14                  forcecontent => 0,                  forcecontent => 0,
15          );          );
16    
17  use Data::Dumper;  my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
18  #print Dumper($config);  sub x {
19            return $from_utf8->convert($_[0]);
20    }
21    
22    # Escape <, >, & and ", and to produce valid XML
23    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
24    my $escape_re  = join '|' => keys %escape;
25    sub e {
26            my $out;
27            foreach my $v (@_) {
28                    $v =~ s/($escape_re)/$escape{$1}/g;
29                    $out .= $v;
30            }
31            return $out;
32    }
33    
34  my $spelling_alt;  my $spelling_alt;
35  # FIX: doesn't work very well  # FIX: doesn't work very well
36    if ($config->{findaffix}) {
37            $spelling_alt = new Lingua::Spelling::Alternative;
38            $spelling_alt->load_findaffix(x($config->{findaffix}));
39    }
40  if ($config->{affix}) {  if ($config->{affix}) {
41          $spelling_alt = new Lingua::Spelling::Alternative;          $spelling_alt = new Lingua::Spelling::Alternative;
42          $spelling_alt->load_findaffix($config->{affix});          $spelling_alt->load_affix(x($config->{affix}));
43  }  }
44    
45  my $hits=0;  my $hits=0;
46  my $max_hits=$config->{max_hits};  my $max_hits=x($config->{max_hits});
47    
48  my %labels;  my %labels;
49  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
50          $labels{$_->{value}} = $from_utf8->convert($_->{content});          $labels{$_->{value}} = x($_->{content});
51    }
52    
53    my $path = param('path');       # limit to this path
54    my %path_label;
55    my @path_name;
56    foreach (@{$config->{paths}->{path}}) {
57            push @path_name,x($_->{limit});
58            $path_label{$_->{limit}} = x($_->{content});
59  }  }
60    
61  print header(-charset=>$CHARSET),start_html(-title=>'Pretrazivanje',-lang=>'hr'),start_form;  my @properties = split(/\s+/,x($config->{properties}));
62  print "Potra¾i ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," dokumenata sa riječima: ",textfield('search');  
63  print submit(-value=>'prika¾i');  if ($config->{charset}) {
64  print checkbox(-name=>'no_affix', -checked=>0, -label=>'ne koristi variranje oblika riječi');          print header(-charset=>x($config->{charset}));
65    } else {
66            print header;
67    }
68    print start_html(-title=>x($config->{title})),start_form;
69    print x($config->{text}->{search});
70    print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
71    print x($config->{text}->{documents});
72    print textfield('search');
73    print submit(-value=> x($config->{text}->{submit}));
74    print br,checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if ($spelling_alt);
75    print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
76    if (@path_name) {
77            print br,x($config->{text}->{limit});
78            print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
79    }
80  print end_form,hr;  print end_form,hr;
81    
82  if (param('search')) {  if (param('search')) {
# Line 83  if (param('search')) { Line 119  if (param('search')) {
119          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;
120          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
121    
122            # limit to some path
123            $s = "swishdocpath=(\"$path\") and $s" if ($path);
124    
125            my %params;     # optional parametars for swish
126    
127            # default format for output
128            my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
129    
130            if (@properties) {
131                    $hit_fmt = x($config->{hit}) if (! param('no_properties'));
132                    $params{properties} = \@properties if (@properties);
133            } else {
134                    $hit_fmt = x($config->{hit}) if (x($config->{hit}));
135            }
136    
137          my $sh = SWISH->connect('Fork',          my $sh = SWISH->connect('Fork',
138                  prog     => $config->{prog},                  prog     => x($config->{prog}),
139                  indexes  => $config->{index},                  indexes  => x($config->{index}),
 #               properties  => [qw/god br nr/],  
140                  results  => sub {                  results  => sub {
141                          my ($sh,$hit) = @_;                          my ($sh,$hit) = @_;
142    
143                          print "<a href=\"",$hit->swishdocpath,"\">",$hit->swishtitle,"</a> [",$hit->swishrank,"]<br>\n";                          if ($config->{url}) {
144                                    printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties));
145                            } else {
146                                    printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
147    
148                            }
149    
150  #                       print $_[1]->as_string,"<br>\n";  #                       print $_[1]->as_string,"<br>\n";
151  #                       my @fields = $hit->field_names;  #                       my @fields = $hit->field_names;
152  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
153                  },                  },
154                  maxhits => param('max_hits') || $max_hits,                  maxhits => param('max_hits') || $max_hits,
155                    \%params,
156          );          );
157    
158          die $SWISH::errstr unless $sh;          die $SWISH::errstr unless $sh;
# Line 105  if (param('search')) { Line 161  if (param('search')) {
161          $hits = $sh->query($s);          $hits = $sh->query($s);
162    
163          if ($hits > 0) {          if ($hits > 0) {
164                  print p,hr,"Prikazujem $hits dokumenata (maks. ",param('max_hits') || $max_hits,")... <small>($s)</small>";                  print p,hr;
165                    printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
166          } else {          } else {
167                  print p,"Nije našen niti jedan dokument... <small>($s, ",$sh->errstr,")</small>";                  print p;
168                    printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
169          }          }
170  } else {  } else {
171          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}));
172  }  }
Legend:
Removed from v.8  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.26