/[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 18 - (show annotations)
Sun Mar 16 21:59:10 2003 UTC (21 years ago) by dpavlin
File size: 3459 byte(s)
decode all strings before output to charset defined in xml file

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 $sh = SWISH->connect('Fork',
99 prog => x($config->{prog}),
100 indexes => x($config->{index}),
101 # properties => [qw/god br nr/],
102 results => sub {
103 my ($sh,$hit) = @_;
104
105 if ($config->{url}) {
106 printf ("<a href=\"%s\">%s</a> [%s]<br>\n","http://".virtual_host().x($config->{url}).$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);
107 } else {
108 printf ("<a href=\"%s\">%s</a> [%s]<br>\n",$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);
109
110 }
111
112 # print $_[1]->as_string,"<br>\n";
113 # my @fields = $hit->field_names;
114 # print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
115 },
116 maxhits => param('max_hits') || $max_hits,
117 );
118
119 die $SWISH::errstr unless $sh;
120
121
122 $hits = $sh->query($s);
123
124 if ($hits > 0) {
125 print p,hr;
126 printf (x($config->{text}->{hits}),$hits,param('max_hits') || $max_hits,$s);
127 } else {
128 print p;
129 printf (x($config->{text}->{no_hits}),$s,$sh->errstr);
130 }
131 } else {
132 print p(x($config->{text}->{footer}));
133 }

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.26