trunk/html/swish.cgi

#!/usr/bin/perl -w

use strict;
use CGI qw/:standard -no_xhtml/;
use CGI::Carp qw(fatalsToBrowser);
use SWISH;
use XML::Simple;
use Lingua::Spelling::Alternative;
use Text::Iconv;

# output charset
my $CHARSET='ISO-8859-2';

Text::Iconv->raise_error(0);     # Conversion errors raise exceptions
my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);

my $config=XMLin(undef,
#               keyattr => { label => "value" },
                forcecontent => 0,
        );

use Data::Dumper;
#print Dumper($config);

my $spelling_alt;
# FIX: doesn't work very well
if ($config->{affix}) {
        $spelling_alt = new Lingua::Spelling::Alternative;
        $spelling_alt->load_findaffix($config->{affix});
}

my $hits=0;
my $max_hits=$config->{max_hits};

my %labels;
foreach (@{$config->{labels}->{label}}) {
        $labels{$_->{value}} = $from_utf8->convert($_->{content});
}

print header(-charset=>$CHARSET),start_html(-title=>'Pretrazivanje',-lang=>'hr'),start_form;
print "Potra¾i ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," dokumenata sa rijeèima: ",textfield('search');
print submit(-value=>'prika¾i');
print checkbox(-name=>'no_affix', -checked=>0, -label=>'ne koristi variranje oblika rijeèi');
print end_form,hr;

if (param('search')) {

        my $s;
        # re-write query from +/- to and/and not

        my $search = param('search');
        my $s_phrase = "";
        while ($search =~ s/\s*("[^"]+")\s*/ /) {
                $s .= "$1 ";
        }
        $search =~ s/^\s+//;
        $search =~ s/\s+$//;

        foreach (split(/\s+/,$search)) {
                if (m/^([+-])(\S+)/) {
                        $s.= ($s) ? "and " : "";
                        $s.="not " if ($1 eq "-");
                        if ($spelling_alt && !param('no_affix')) {
                                my $w = $2; $w =~ s/[\*\s]+//g;
                                $w =~ s/^(['"]*)([^'"]+)(['"]*)/$2/;
                                $s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
                        } else {
                                $s.="$2* ";
                        }
                } else {
                        if ($spelling_alt && !param('no_affix')) {
                                my $w = $_; $w =~ s/[\*\s]+//g;
                                #$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
                                $s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
                        } else {
                                $s.="$_* ";
                        }
                }
        }

        # fixup search string
        $s=~tr/ðèæÐÈÆ/¹ð¾èæ©Ð®ÈÆ/;  # 1250 -> iso8859-2
        $s=~tr/¹©ðÐèÈæÆ¾®/sSdDcCcCzZ/;
        $s=~s/\*\*+/*/g;

        my $sh = SWISH->connect('Fork',
                prog     => $config->{prog},
                indexes  => $config->{index},
#               properties  => [qw/god br nr/],
                results  => sub {
                        my ($sh,$hit) = @_;

                        print "<a href=\"",$hit->swishdocpath,"\">",$hit->swishtitle,"</a> [",$hit->swishrank,"]<br>\n";

#                       print $_[1]->as_string,"<br>\n";
#                       my @fields = $hit->field_names;
#                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
                },
                maxhits => param('max_hits') || $max_hits,
        );

        die $SWISH::errstr unless $sh;


        $hits = $sh->query($s);

        if ($hits > 0) {
                print p,hr,"Prikazujem $hits dokumenata (maks. ",param('max_hits') || $max_hits,")... <small>($s)</small>";
        } else {
                print p,"Nije naðen niti jedan dokument... <small>($s, ",$sh->errstr,")</small>";
        }
} else {
        print p('Kod pretra¾ivanja pretra¾ivaè pronalazi sve dokumente u kojima se pojavljuju <b>sve upisanje rijeèi</b>.',br,'Ako ispred rijeèi upi¹ete minus (-) neæe se prikazivati dokumenti koji imaju takvu rijeè. Npr. <tt>+mreza -novak</tt>');
}
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			if ($config->{affix}) {
28			$spelling_alt = new Lingua::Spelling::Alternative;
29			$spelling_alt->load_findaffix($config->{affix});
30			}
31
32			my $hits=0;
33			my $max_hits=$config->{max_hits};
34
35			my %labels;
36			foreach (@{$config->{labels}->{label}}) {
37			$labels{$_->{value}} = $from_utf8->convert($_->{content});
38			}
39
40			print header(-charset=>$CHARSET),start_html(-title=>'Pretrazivanje',-lang=>'hr'),start_form;
41			print "Potra¾i ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," dokumenata sa rijeèima: ",textfield('search');
42			print submit(-value=>'prika¾i');
43			print checkbox(-name=>'no_affix', -checked=>0, -label=>'ne koristi variranje oblika rijeèi');
44			print end_form,hr;
45
46			if (param('search')) {
47
48			my $s;
49			# re-write query from +/- to and/and not
50
51			my $search = param('search');
52			my $s_phrase = "";
53			while ($search =~ s/\s("[^"]+")\s/ /) {
54			$s .= "$1 ";
55			}
56			$search =~ s/^\s+//;
57			$search =~ s/\s+$//;
58
59			foreach (split(/\s+/,$search)) {
60			if (m/^([+-])(\S+)/) {
61			$s.= ($s) ? "and " : "";
62			$s.="not " if ($1 eq "-");
63			if ($spelling_alt && !param('no_affix')) {
64			my $w = $2; $w =~ s/[\*\s]+//g;
65			$w =~ s/^(['"])([^'"]+)(['"])/$2/;
66			$s.="$1(".join("* or ",$spelling_alt->alternatives($w))."*)$3 ";
67			} else {
68			$s.="$2* ";
69			}
70			} else {
71			if ($spelling_alt && !param('no_affix')) {
72			my $w = $_; $w =~ s/[\*\s]+//g;
73			#$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
74			$s.="(".join("* or ",$spelling_alt->alternatives($w))."*) ";
75			} else {
76			$s.="$_* ";
77			}
78			}
79			}
80
81			# fixup search string
82			$s=~tr/ðèæÐÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
83			$s=~tr/¹©ðÐèÈæÆ¾®/sSdDcCcCzZ/;
84			$s=~s/\\+/*/g;
85
86			my $sh = SWISH->connect('Fork',
87			prog => $config->{prog},
88			indexes => $config->{index},
89			# properties => [qw/god br nr/],
90			results => sub {
91			my ($sh,$hit) = @_;
92
93			print "<a href=\"",$hit->swishdocpath,"\">",$hit->swishtitle,"</a> [",$hit->swishrank,"]<br>\n";
94
95			# print $_[1]->as_string,"<br>\n";
96			# my @fields = $hit->field_names;
97			# print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
98			},
99			maxhits => param('max_hits') \|\| $max_hits,
100			);
101
102			die $SWISH::errstr unless $sh;
103
104
105			$hits = $sh->query($s);
106
107			if ($hits > 0) {
108			print p,hr,"Prikazujem $hits dokumenata (maks. ",param('max_hits') \|\| $max_hits,")... <small>($s)</small>";
109			} else {
110			print p,"Nije naðen niti jedan dokument... <small>($s, ",$sh->errstr,")</small>";
111			}
112			} else {
113			print p('Kod pretra¾ivanja pretra¾ivaè pronalazi sve dokumente u kojima se pojavljuju <b>sve upisanje rijeèi</b>.',br,'Ako ispred rijeèi upi¹ete minus (-) neæe se prikazivati dokumenti koji imaju takvu rijeè. Npr. <tt>+mreza -novak</tt>');
114			}