/[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 22 - (show annotations)
Tue Mar 18 20:24:57 2003 UTC (17 years, 4 months ago) by dpavlin
File size: 3653 byte(s)
properties are optional

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 use Data::Dumper;
23 #print Dumper($config);
24
25 my $spelling_alt;
26 # FIX: doesn't work very well
27 if ($config->{findaffix}) {
28 $spelling_alt = new Lingua::Spelling::Alternative;
29 $spelling_alt->load_findaffix(x($config->{findaffix}));
30 }
31 if ($config->{affix}) {
32 $spelling_alt = new Lingua::Spelling::Alternative;
33 $spelling_alt->load_affix(x($config->{affix}));
34 }
35
36 my $hits=0;
37 my $max_hits=x($config->{max_hits});
38
39 my %labels;
40 foreach (@{$config->{labels}->{label}}) {
41 $labels{$_->{value}} = x($_->{content});
42 }
43
44 if ($config->{charset}) {
45 print header(-charset=>x($config->{charset}));
46 } else {
47 print header;
48 }
49 print start_html(-title=>x($config->{title})),start_form;
50 print x($config->{text}->{search});
51 print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
52 print x($config->{text}->{documents});
53 print textfield('search');
54 print submit(-value=> x($config->{text}->{submit}));
55 print checkbox(-name=>'no_affix', -checked=>0, -label=>x($config->{text}->{no_spell})) if ($spelling_alt);
56 print end_form,hr;
57
58 if (param('search')) {
59
60 my $s;
61 # re-write query from +/- to and/and not
62
63 my $search = param('search');
64 my $s_phrase = "";
65 while ($search =~ s/\s*("[^"]+")\s*/ /) {
66 $s .= "$1 ";
67 }
68 $search =~ s/^\s+//;
69 $search =~ s/\s+$//;
70
71 foreach (split(/\s+/,$search)) {
72 if (m/^([+-])(\S+)/) {
73 $s.= ($s) ? "and " : "";
74 $s.="not " if ($1 eq "-");
75 if ($spelling_alt && !param('no_affix')) {
76 my $w = $2; $w =~ s/[\*\s]+//g;
77 $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
78 $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
79 } else {
80 $s.="$2* ";
81 }
82 } else {
83 if ($spelling_alt && !param('no_affix')) {
84 my $w = $_; $w =~ s/[\*\s]+//g;
85 #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
86 $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
87 } else {
88 $s.="$_* ";
89 }
90 }
91 }
92
93 # fixup search string
94 $s=~tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
95 $s=~tr/¹©ðÐèÈæƾ®/sSdDcCcCzZ/;
96 $s=~s/\*\*+/*/g;
97
98 my %params; # optional parametars for swish
99
100 my @properties = split(/\s+/,x($config->{properties}));
101 $params{properties} = \@properties if (@properties);
102
103 my $sh = SWISH->connect('Fork',
104 prog => x($config->{prog}),
105 indexes => x($config->{index}),
106 results => sub {
107 my ($sh,$hit) = @_;
108
109 my $hit_fmt = x($config->{hit}) ||
110 "<a href=\"%s\">%s</a> [%s]<br>\n";
111
112 if ($config->{url}) {
113 printf ($hit_fmt ,"http://".virtual_host().x($config->{url}).$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);
114 } else {
115 printf ($hit_fmt ,$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank, map($hit->$_, @properties) );
116
117 }
118
119 # print $_[1]->as_string,"<br>\n";
120 # my @fields = $hit->field_names;
121 # print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
122 },
123 maxhits => param('max_hits') || $max_hits,
124 \%params,
125 );
126
127 die $SWISH::errstr unless $sh;
128
129
130 $hits = $sh->query($s);
131
132 if ($hits > 0) {
133 print p,hr;
134 printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
135 } else {
136 print p;
137 printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
138 }
139 } else {
140 print p(x($config->{text}->{footer}));
141 }

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.26