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

Annotation of /trunk/html/swish.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (hide annotations)
Mon Mar 24 09:04:57 2003 UTC (21 years ago) by dpavlin
File size: 4319 byte(s)
escape special characters in title

1 dpavlin 8 #!/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 dpavlin 18 my $from_utf8 = Text::Iconv->new('UTF8', $config->{charset});
18     sub x {
19     return $from_utf8->convert($_[0]);
20     }
21    
22 dpavlin 29 # 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 dpavlin 8
34     my $spelling_alt;
35     # FIX: doesn't work very well
36 dpavlin 16 if ($config->{findaffix}) {
37 dpavlin 8 $spelling_alt = new Lingua::Spelling::Alternative;
38 dpavlin 18 $spelling_alt->load_findaffix(x($config->{findaffix}));
39 dpavlin 8 }
40 dpavlin 16 if ($config->{affix}) {
41     $spelling_alt = new Lingua::Spelling::Alternative;
42 dpavlin 18 $spelling_alt->load_affix(x($config->{affix}));
43 dpavlin 16 }
44 dpavlin 8
45     my $hits=0;
46 dpavlin 18 my $max_hits=x($config->{max_hits});
47 dpavlin 8
48     my %labels;
49     foreach (@{$config->{labels}->{label}}) {
50 dpavlin 18 $labels{$_->{value}} = x($_->{content});
51 dpavlin 8 }
52    
53 dpavlin 23 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 dpavlin 16 if ($config->{charset}) {
62 dpavlin 18 print header(-charset=>x($config->{charset}));
63 dpavlin 16 } else {
64     print header;
65     }
66 dpavlin 18 print start_html(-title=>x($config->{title})),start_form;
67     print x($config->{text}->{search});
68 dpavlin 16 print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
69 dpavlin 18 print x($config->{text}->{documents});
70 dpavlin 16 print textfield('search');
71 dpavlin 18 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 dpavlin 23 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 dpavlin 8 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 dpavlin 23 # limit to some path
120 dpavlin 27 $s = "swishdocpath=(\"$path\") and $s" if ($path);
121 dpavlin 23
122 dpavlin 22 my %params; # optional parametars for swish
123    
124 dpavlin 21 my @properties = split(/\s+/,x($config->{properties}));
125 dpavlin 22 $params{properties} = \@properties if (@properties);
126 dpavlin 21
127 dpavlin 8 my $sh = SWISH->connect('Fork',
128 dpavlin 18 prog => x($config->{prog}),
129     indexes => x($config->{index}),
130 dpavlin 8 results => sub {
131     my ($sh,$hit) = @_;
132    
133 dpavlin 21 my $hit_fmt = x($config->{hit}) ||
134     "<a href=\"%s\">%s</a> [%s]<br>\n";
135    
136 dpavlin 18 if ($config->{url}) {
137 dpavlin 29 printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank);
138 dpavlin 18 } else {
139 dpavlin 29 printf ($hit_fmt ,$hit->swishdocpath,e($hit->swishtitle) || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
140 dpavlin 8
141 dpavlin 18 }
142    
143 dpavlin 8 # 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 dpavlin 22 \%params,
149 dpavlin 8 );
150    
151     die $SWISH::errstr unless $sh;
152    
153    
154     $hits = $sh->query($s);
155    
156     if ($hits > 0) {
157 dpavlin 16 print p,hr;
158 dpavlin 18 printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
159 dpavlin 8 } else {
160 dpavlin 16 print p;
161 dpavlin 18 printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
162 dpavlin 8 }
163     } else {
164 dpavlin 18 print p(x($config->{text}->{footer}));
165 dpavlin 8 }

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.26