/[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 39 by dpavlin, Sun Jun 1 11:41:39 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 @spellings;
35  # FIX: doesn't work very well  # FIX: doesn't work very well
36  if ($config->{findaffix}) {  if ($config->{findaffix}) {
37          $spelling_alt = new Lingua::Spelling::Alternative;          my $spelling_alt = new Lingua::Spelling::Alternative;
38          $spelling_alt->load_findaffix($config->{affix});          $spelling_alt->load_findaffix(x($config->{findaffix}));
39            push @spellings,$spelling_alt;
40  }  }
41  if ($config->{affix}) {  if ($config->{affix}) {
42          $spelling_alt = new Lingua::Spelling::Alternative;          my $spelling_alt = new Lingua::Spelling::Alternative;
43          $spelling_alt->load_affix($config->{affix});          $spelling_alt->load_affix(x($config->{affix}));
44            push @spellings,$spelling_alt;
45  }  }
46    
47  my $hits=0;  my $hits=0;
48  my $max_hits=$config->{max_hits};  my $max_hits=x($config->{max_hits});
49    
50  my %labels;  my %labels;
51  foreach (@{$config->{labels}->{label}}) {  foreach (@{$config->{labels}->{label}}) {
52          $labels{$_->{value}} = $from_utf8->convert($_->{content});          $labels{$_->{value}} = x($_->{content});
53    }
54    
55    my $path = param('path');       # limit to this path
56    my %path_label;
57    my @path_name;
58    foreach (@{$config->{paths}->{path}}) {
59    
60    print STDERR "##: $_->{limit}",x($_->{content}),"\n";
61            push @path_name,x($_->{limit});
62            $path_label{$_->{limit}} = x($_->{content});
63  }  }
64    
65    my @properties = split(/\s+/,x($config->{properties}));
66    
67  if ($config->{charset}) {  if ($config->{charset}) {
68          print header(-charset=>$config->{charset});          print header(-charset=>x($config->{charset}));
69  } else {  } else {
70          print header;          print header;
71  }  }
72  print start_html(-title=>$config->{title}),start_form;  print start_html(-title=>x($config->{title})),start_form;
73  print $config->{text}->{search};  print x($config->{text}->{search});
74  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);
75  print $config->{text}->{documents};  print x($config->{text}->{documents});
76  print textfield('search');  print textfield('search');
77  print submit(-value=> $config->{text}->{submit});  print submit(-value=> x($config->{text}->{submit}));
78  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);
79    print checkbox(-name=>'no_properties', -checked=>0, -label=>($config->{text}->{no_properties})) if (@properties);
80    if (@path_name) {
81            print br,x($config->{text}->{limit});
82            print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
83    }
84  print end_form,hr;  print end_form,hr;
85    
86  if (param('search')) {  if (param('search')) {
# Line 72  if (param('search')) { Line 100  if (param('search')) {
100                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
101                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
102                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
103                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
104                                  my $w = $2; $w =~ s/[\*\s]+//g;                                  my $w = $2; $w =~ s/[\*\s]+//g;
105                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;                                  $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
106                                  $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";                                  my $or="";
107                                    foreach my $spelling_alt (@spellings) {
108                                            $s.="$or$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
109                                            $or = "or ";
110                                    }
111                          } else {                          } else {
112                                  $s.="$2* ";                                  $s.="$2* ";
113                          }                          }
114                  } else {                  } else {
115                          if ($spelling_alt && !param('no_affix')) {                          if (@spellings && !param('no_affix')) {
116                                  my $w = $_; $w =~ s/[\*\s]+//g;                                  my $w = $_; $w =~ s/[\*\s]+//g;
117                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
118                                  $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";                                  my $or="";
119                                    foreach my $spelling_alt (@spellings) {
120                                            $s.="$or(".join("* or ",$spelling_alt->alternatives($w))."*) ";
121                                            $or = "or ";
122                                    }
123                          } else {                          } else {
124                                  $s.="$_* ";                                  $s.="$_* ";
125                          }                          }
# Line 95  if (param('search')) { Line 131  if (param('search')) {
131          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;          $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
132          $s=~s/\*\*+/*/g;          $s=~s/\*\*+/*/g;
133    
134            # limit to some path
135            $s = "swishdocpath=(\"*$path*\") and $s" if ($path);
136    
137            my %params;     # optional parametars for swish
138    
139            # default format for output
140            my $hit_fmt = "<a href=\"%s\">%s</a> [%s]<br>\n";
141    
142            if (@properties) {
143                    $hit_fmt = x($config->{hit}) if (! param('no_properties'));
144                    $params{properties} = \@properties;
145            } else {
146                    $hit_fmt = x($config->{hit}) if (x($config->{hit}));
147            }
148    
149          my $sh = SWISH->connect('Fork',          my $sh = SWISH->connect('Fork',
150                  prog     => $config->{prog},                  prog     => x($config->{prog}),
151                  indexes  => $config->{index},                  indexes  => x($config->{index}),
 #               properties  => [qw/god br nr/],  
152                  results  => sub {                  results  => sub {
153                          my ($sh,$hit) = @_;                          my ($sh,$hit) = @_;
154    
155                          printf ("<a href=\"%s\">%s</a> [%s]<br>\n","http://".virtual_host().$config->{url}.$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);                          if ($config->{url}) {
156                                    printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties));
157                            } else {
158                                    printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
159    
160                            }
161    
162  #                       print $_[1]->as_string,"<br>\n";  #                       print $_[1]->as_string,"<br>\n";
163  #                       my @fields = $hit->field_names;  #                       my @fields = $hit->field_names;
164  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
165                  },                  },
166                  maxhits => param('max_hits') || $max_hits,                  maxhits => param('max_hits') || $max_hits,
167                    \%params,
168          );          );
169    
170          die $SWISH::errstr unless $sh;          die $SWISH::errstr unless $sh;
# Line 116  if (param('search')) { Line 172  if (param('search')) {
172    
173          $hits = $sh->query($s);          $hits = $sh->query($s);
174    
175          if ($hits > 0) {          if ($hits && $hits > 0) {
176                  print p,hr;                  print p,hr;
177                  printf ($config->{text}->{hits},$hits,param('max_hits') || $max_hits,$s);                  printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
178          } else {          } else {
179                  print p;                  print p;
180                  printf ($config->{text}->{no_hits},$s,$sh->errstr);                  printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
181          }          }
182  } else {  } else {
183          print p($config->{text}->{footer});          print p(x($config->{text}->{footer}));
184  }  }
Legend:
Removed from v.16  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.26