/[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 29 - (show annotations)
Mon Mar 24 09:04:57 2003 UTC (17 years, 3 months ago) by dpavlin
File size: 4319 byte(s)
escape special characters in title

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;
7 use XML::Simple;
8 use Lingua::Spelling::Alternative;
9 use Text::Iconv;
10
11 Text::Iconv->raise_error(0); # Conversion errors raise exceptions
12 my $config=XMLin(undef,
13 # keyattr => { label => "value" },
14 forcecontent => 0,
15 );
16
17 my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
18 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;
35 # 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}) {
41 $spelling_alt = new Lingua::Spelling::Alternative;
42 $spelling_alt->load_affix(x($config->{affix}));
43 }
44
45 my $hits=0;
46 my $max_hits=x($config->{max_hits});
47
48 my %labels;
49 foreach (@{$config->{labels}->{label}}) {
50 $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 if ($config->{charset}) {
62 print header(-charset=>x($config->{charset}));
63 } else {
64 print header;
65 }
66 print start_html(-title=>x($config->{title})),start_form;
67 print x($config->{text}->{search});
68 print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
69 print x($config->{text}->{documents});
70 print textfield('search');
71 print submit(-value=> x($config->{text}->{submit}));
72 print checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if ($spelling_alt);
73 if (@path_name) {
74 print br,x($config->{text}->{limit});
75 print popup_menu(-name=>'path',-values=>\@path_name,-labels=>\%path_label,-default=>$path);
76 }
77 print end_form,hr;
78
79 if (param('search')) {
80
81 my $s;
82 # re-write query from +/- to and/and not
83
84 my $search = param('search');
85 my $s_phrase = "";
86 while ($search =~ s/\s*("[^"]+")\s*/ /) {
87 $s .= "$1 ";
88 }
89 $search =~ s/^\s+//;
90 $search =~ s/\s+$//;
91
92 foreach (split(/\s+/,$search)) {
93 if (m/^([+-])(\S+)/) {
94 $s.= ($s) ? "and " : "";
95 $s.="not " if ($1 eq "-");
96 if ($spelling_alt && !param('no_affix')) {
97 my $w = $2; $w =~ s/[\*\s]+//g;
98 $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
99 $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
100 } else {
101 $s.="$2* ";
102 }
103 } else {
104 if ($spelling_alt && !param('no_affix')) {
105 my $w = $_; $w =~ s/[\*\s]+//g;
106 #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
107 $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
108 } else {
109 $s.="$_* ";
110 }
111 }
112 }
113
114 # fixup search string
115 $s=~tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
116 $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
117 $s=~s/\*\*+/*/g;
118
119 # limit to some path
120 $s = "swishdocpath=(\"$path\") and $s" if ($path);
121
122 my %params; # optional parametars for swish
123
124 my @properties = split(/\s+/,x($config->{properties}));
125 $params{properties} = \@properties if (@properties);
126
127 my $sh = SWISH->connect('Fork',
128 prog => x($config->{prog}),
129 indexes => x($config->{index}),
130 results => sub {
131 my ($sh,$hit) = @_;
132
133 my $hit_fmt = x($config->{hit}) ||
134 "<a href=\"%s\">%s</a> [%s]<br>\n";
135
136 if ($config->{url}) {
137 printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank);
138 } else {
139 printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
140
141 }
142
143 # print $_[1]->as_string,"<br>\n";
144 # my @fields = $hit->field_names;
145 # print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
146 },
147 maxhits => param('max_hits') || $max_hits,
148 \%params,
149 );
150
151 die $SWISH::errstr unless $sh;
152
153
154 $hits = $sh->query($s);
155
156 if ($hits > 0) {
157 print p,hr;
158 printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
159 } else {
160 print p;
161 printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
162 }
163 } else {
164 print p(x($config->{text}->{footer}));
165 }

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.26