/[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 16 - (hide annotations)
Sun Mar 16 21:44:42 2003 UTC (21 years ago) by dpavlin
File size: 3257 byte(s)
moved all text into configuration file

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     # output charset
12     my $CHARSET='ISO-8859-2';
13    
14     Text::Iconv->raise_error(0); # Conversion errors raise exceptions
15     my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);
16    
17     my $config=XMLin(undef,
18     # keyattr => { label => "value" },
19     forcecontent => 0,
20     );
21    
22     use Data::Dumper;
23     #print Dumper($config);
24    
25     my $spelling_alt;
26     # FIX: doesn't work very well
27 dpavlin 16 if ($config->{findaffix}) {
28 dpavlin 8 $spelling_alt = new Lingua::Spelling::Alternative;
29     $spelling_alt->load_findaffix($config->{affix});
30     }
31 dpavlin 16 if ($config->{affix}) {
32     $spelling_alt = new Lingua::Spelling::Alternative;
33     $spelling_alt->load_affix($config->{affix});
34     }
35 dpavlin 8
36     my $hits=0;
37     my $max_hits=$config->{max_hits};
38    
39     my %labels;
40     foreach (@{$config->{labels}->{label}}) {
41     $labels{$_->{value}} = $from_utf8->convert($_->{content});
42     }
43    
44 dpavlin 16 if ($config->{charset}) {
45     print header(-charset=>$config->{charset});
46     } else {
47     print header;
48     }
49     print start_html(-title=>$config->{title}),start_form;
50     print $config->{text}->{search};
51     print popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits);
52     print $config->{text}->{documents};
53     print textfield('search');
54     print submit(-value=> $config->{text}->{submit});
55     print checkbox(-name=>'no_affix', -checked=>0, -label=>$config->{text}->{no_spell}) if ($spelling_alt);
56 dpavlin 8 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 => $config->{prog},
100     indexes => $config->{index},
101     # properties => [qw/god br nr/],
102     results => sub {
103     my ($sh,$hit) = @_;
104    
105 dpavlin 16 printf ("<a href=\"%s\">%s</a> [%s]<br>\n","http://".virtual_host().$config->{url}.$hit->swishdocpath,$hit->swishtitle || 'untitled',$hit->swishrank);
106 dpavlin 8
107     # print $_[1]->as_string,"<br>\n";
108     # my @fields = $hit->field_names;
109     # print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
110     },
111     maxhits => param('max_hits') || $max_hits,
112     );
113    
114     die $SWISH::errstr unless $sh;
115    
116    
117     $hits = $sh->query($s);
118    
119     if ($hits > 0) {
120 dpavlin 16 print p,hr;
121     printf ($config->{text}->{hits},$hits,param('max_hits') || $max_hits,$s);
122 dpavlin 8 } else {
123 dpavlin 16 print p;
124     printf ($config->{text}->{no_hits},$s,$sh->errstr);
125 dpavlin 8 }
126     } else {
127 dpavlin 16 print p($config->{text}->{footer});
128 dpavlin 8 }

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.26