/[nn.old]/trunk/search/nn-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

Diff of /trunk/search/nn-swish.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 90 by dpavlin, Tue Sep 9 08:20:53 2003 UTC revision 91 by dpavlin, Sun Sep 28 02:19:59 2003 UTC
# Line 5  use CGI qw/:standard -no_xhtml/; Line 5  use CGI qw/:standard -no_xhtml/;
5  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
6  use SWISH;  use SWISH;
7  use Unicode::String qw(utf8 utf16);  use Unicode::String qw(utf8 utf16);
8    use Lingua::Spelling::Alternative;
9  require Unicode::Map8;  require Unicode::Map8;
10  use GDBM_File;  use GDBM_File;
11    
12  my $dir='/home/dpavlin/nn/swish';  my $dir='/home/dpavlin/nn';
13  my $prog='/usr/bin/swish-e';  my $prog='/usr/bin/swish-e';
14    my $url='http://www.nn.hr/clanci/sluzbeno/';
15    
16  my $hits=0;  my $hits=0;
17  my $max_hits=100;  my $max_hits=100;
18    
19  my %labels = (100=>' 100', 200=>' 200', 500=>' 500', 0=>'neograničeno');  my %labels = (100=>' 100', 200=>' 200', 500=>' 500', 0=>'neograničeno');
20    my %index = ('title'=>'naslovu', 'text'=>'tekstu');
21    
22  my %brs_labels;  my %brs_labels;
23    
24  my %tie;  my %brzakona;
25  tie %tie, 'GDBM_File', "$dir/brzakona.gdbm", &GDBM_READER, 0640 || die "tie: $!";  tie %brzakona, 'GDBM_File', "$dir/swish/brzakona.gdbm", &GDBM_READER, 0640 || die "tie: $!";
26  foreach (sort keys %tie) {  foreach (sort keys %brzakona) {
27          $brs_labels{$_} = sprintf("%-8s (%d zakona)",$_,$tie{$_});          $brs_labels{$_} = sprintf("%-8s (%d zakona)",$_,$brzakona{$_});
28  }  }
29  untie %tie;  untie %brzakona;
30    
31    my %file2title;
32    tie %file2title, 'GDBM_File', "$dir/swish/file2title.gdbm", &GDBM_READER, 0640 || die "tie: $!";
33    
34    my $hr = new Lingua::Spelling::Alternative( DEBUG => 0 );
35    $hr->load_findaffix("$dir/prvih_50.txt");
36    
37  print header(-charset=>'iso-8859-2'),start_html(-title=>'NN pretrazivanje',-lang=>'hr'),start_form;  print header(-charset=>'iso-8859-2'),start_html(-title=>'NN pretrazivanje',-lang=>'hr'),start_form;
38  print "Potraži ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," zakona sa riječima: ",textfield('search');  print "Potraži ",popup_menu(-name=>'max_hits',-values=>[ sort keys %labels ],-labels=>\%labels,-default=>$max_hits)," zakona sa riječima: ",textfield('search');
39    print " u ",popup_menu(-name=>'index',-values=>[ sort keys %index ],-labels=>\%index,-default=>'title')," zakona ";
40  print submit(-value=>'prikaži');  print submit(-value=>'prikaži');
41  print br,checkbox(-name=>'br_limit', -checked=>0, -label=>"ograniči pretraživanje samo na broj "),popup_menu(-name=>'br',-values=>[sort keys %brs_labels],-labels=>\%brs_labels);  print br,checkbox(-name=>'br_limit', -checked=>0, -label=>"ograniči pretraživanje samo na godinu "),popup_menu(-name=>'br',-values=>[sort keys %brs_labels],-labels=>\%brs_labels);
42  print end_form,hr;  print end_form,hr;
43    
44  if (param('search')) {  if (param('search')) {
# Line 39  if (param('search')) { Line 49  if (param('search')) {
49                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
50                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
51                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
52                          $s.="$2* ";                          $s.="(".join("* or ",$hr->alternatives($2)).") ";
53                  } else {                  } else {
54                          $s .= "$_* ";                          $s .= "(".join("* or ",$hr->alternatives($_)).") ";
55                  }                  }
56          }          }
57          $s=~tr/šđžčćŠĐŽČĆ/šđžčćŠĐŽČĆ/;  # 1250 -> iso8859-2          $s=~tr/šđžčćŠĐŽČĆ/šđžčćŠĐŽČĆ/;  # 1250 -> iso8859-2
# Line 50  if (param('search')) { Line 60  if (param('search')) {
60          my $l2_map = Unicode::Map8->new("ISO-8859-2") || die;          my $l2_map = Unicode::Map8->new("ISO-8859-2") || die;
61          my $us = Unicode::String->new();          my $us = Unicode::String->new();
62    
63          my $sh = SWISH->connect('Fork',          my $sw_q;
64                  prog     => $prog,          my $sh;
65                  indexes  => "$dir/nn.index",  
66                  properties  => [qw/god br nr/],          if (param('index') eq 'title') {
67                  results  => sub {  
68                          my ($sh,$hit) = @_;                  $sh = SWISH->connect('Fork',
69                            prog     => $prog,
70                          $us->utf8($hit->swishtitle);                          indexes  => "$dir/swish/nn.index",
71                            properties  => [qw/god br nr/],
72                          print "<a href=\"",$hit->swishdocpath,"\"><tt>NN",$hit->god,"/",$hit->br,"</a> ",$hit->nr," </tt>",$l2_map->to8($us->utf16),"</a> [",$hit->swishrank,"]<br>\n";                          results  => sub {
73                                    my ($sh,$hit) = @_;
74  #                       print $_[1]->as_string,"<br>\n";  
75  #                       my @fields = $hit->field_names;                                  $us->utf8($hit->swishtitle);
76  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;  
77                  },                                  print "<tt><a href=\"$url",$hit->swishdocpath,"\">NN",$hit->god,"/",$hit->br,"</a> ",$hit->nr," </tt>",$l2_map->to8($us->utf16)," [",$hit->swishrank,"]<br>\n";
78                  maxhits => param('max_hits') || $max_hits,  
79          );          #                       print $_[1]->as_string,"<br>\n";
80            #                       my @fields = $hit->field_names;
81          die $SWISH::errstr unless $sh;          #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
82                            },
83          my $sw_q = "naslov_czs=($s)";                          maxhits => param('max_hits') || $max_hits,
84                    );
85          if (param('br_limit')) {  
86                  my ($god,$br) = split(/\//,param('br'));                  die $SWISH::errstr unless $sh;
87                  $sw_q .= " and god=".int($god) if ($god);  
88                  $sw_q .= " and br=".int($br) if ($br);                  $sw_q = "naslov_czs=($s)";
89                    if (param('br_limit')) {
90                            $sw_q .= " and god=".int(param('br')) if (param('br'));
91                    }
92    
93            } else {
94                    # search in full text
95    
96                    $sh = SWISH->connect('Fork',
97                            prog     => $prog,
98                            indexes  => "$dir/swish/sluzbeno.index",
99                            results  => sub {
100                                    my ($sh,$hit) = @_;
101    
102                                    my $path = $hit->swishdocpath;
103                                    if ($file2title{$path}) {
104                                            my ($god,$br,$nr,undef,$naslov) = split(/ /,$file2title{$path},5);
105                                            print "<tt><a href=\"$url",$path,"\">NN$god/$br</a> $nr</tt> $naslov [",$hit->swishrank,"]<br>\n";
106    
107                                    } else {
108                                            print "<!-- error! can't find $path -->\n";
109                                    }
110    
111                            },
112                            maxhits => param('max_hits') || $max_hits,
113                    );
114    
115                    die $SWISH::errstr unless $sh;
116    
117                    $sw_q = $s;
118                    if (param('br_limit')) {
119                            $sw_q .= " and swishdocpath=".int(param('br')) if (param('br'));
120                    }
121    
122          }          }
123    
124          print "<!-- swish query: $sw_q -->";          print "<!-- swish query: $sw_q -->";
# Line 91  if (param('search')) { Line 134  if (param('search')) {
134          }          }
135  } else {  } else {
136          print p('Kod pretraživanja pretraživač pronalazi sve zakone u kojima se pojavljuju <b>sve upisanje riječi</b>.',br,'Ako ispred riječi upišete minus (-) neće se prikazivati zakoni koji imaju takvu riječ. Npr. <tt>+kava +zakon -dopunama</tt>');          print p('Kod pretraživanja pretraživač pronalazi sve zakone u kojima se pojavljuju <b>sve upisanje riječi</b>.',br,'Ako ispred riječi upišete minus (-) neće se prikazivati zakoni koji imaju takvu riječ. Npr. <tt>+kava +zakon -dopunama</tt>');
137          print p("Možete pročitati i <a href=\"http://www.rot13.org/~dpavlin/nn.html\">članak</a> o tome kako je ovaj pretraživač napravljen i zašto."),p("Ovo je <i>nova i brža verzija pretraživača</i> o kojoj <a href=\"http://www.rot13.org/~dpavlin/nn.html#buducnost\">više možete saznati</a> iz članka.");          print p("Možete pročitati i <a href=\"http://www.rot13.org/~dpavlin/nn.html\">članak</a> o tome kako je ovaj pretraživač napravljen i zašto."),p("Ovo je <i>nova i brža verzija pretraživača</i> o kojoj <a href=\"http://www.rot13.org/~dpavlin/nn.html#buducnost\">više možete saznati</a> iz članka."),p("Novosti od rujna 2003.: pretraživanje po godinama i po punom tekstu zakona!");
138  }  }
139    
140    untie %file2title;

Legend:
Removed from v.90  
changed lines
  Added in v.91

  ViewVC Help
Powered by ViewVC 1.1.26