/[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 78 by dpavlin, Wed Jun 26 12:14:54 2002 UTC revision 106 by dpavlin, Mon Aug 4 15:28:56 2008 UTC
# Line 2  Line 2 
2    
3  use strict;  use strict;
4  use CGI qw/:standard -no_xhtml/;  use CGI qw/:standard -no_xhtml/;
 use Text::Query;  
5  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
6  use SWISH;  use SWISH::API;
7  use Unicode::String qw(utf8 utf16);  use Lingua::Spelling::Alternative;
8  require Unicode::Map8;  use Encode qw/from_to/;
9    use GDBM_File;
10    use lib '/data/swish/html';
11    use FormatResult;
12    
13    my $dir='/home/dpavlin/nn';
14    #my $prog='/usr/bin/swish-e';
15    my $url='http://www.nn.hr/clanci/sluzbeno/';
16    
 my $dir='/home/dpavlin/nn/swish';  
   
 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 %god_lables;
23    
24    my %brzakona;
25    tie %brzakona, 'GDBM_File', "$dir/swish/brzakona.gdbm", &GDBM_READER, 0640 || die "tie: $!";
26    foreach (sort keys %brzakona) {
27            $god_lables{$_} = sprintf("%-8s (%d zakona)",$_,$brzakona{$_});
28    }
29    untie %brzakona;
30    
31  print header(-charset=>'iso-8859-2'),start_html(-title=>'NN pretrazivanje',-lang=>'hr'),start_form;  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 - Narodne Novine pretrazivanje',-lang=>'hr'),start_form(-name=>'search_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=>'god_limit', -checked=>0, -label=>"ograniči pretra¾ivanje samo na godinu "),popup_menu(-name=>'god',-values=>[sort keys %god_lables],-labels=>\%god_lables,-onChange=>'this.form.god_limit.checked=true');
42  print end_form,hr;  print end_form,hr;
43    
44  if (param('search')) {  if (param('search')) {
45    
46          my $s;          my $s;
47          # re-write query from +/- to and/and not          # re-write query from +/- to and/and not
48    
49            my @hl_words;
50    
51          foreach (split(/\s+/,param('search'))) {          foreach (split(/\s+/,param('search'))) {
52                  if (m/^([+-])(\S+)/) {                  if (m/^([+-])(\S+)/) {
53                          $s.= ($s) ? "and " : "";                          $s.= ($s) ? "and " : "";
54                          $s.="not " if ($1 eq "-");                          $s.="not " if ($1 eq "-");
55                          $s.="$2 ";                          my @alt = $hr->alternatives($2);
56                            $s.="(".join("* or ",@alt).") ";
57                            push @hl_words, \@alt if ($1 ne "-");
58                  } else {                  } else {
59                          $s .= "$_ ";                          my @alt = $hr->alternatives($_);
60                            $s .= "(".join("* or ",@alt).") ";
61                            push @hl_words, \@alt;
62                  }                  }
63          }          }
64          $s=~tr/ššžčꊩŽČĘ/¹š¾čę©Š®ČĘ/;  # 1250 -> iso8859-2          $s=~tr/ššžčꊩŽČĘ/¹š¾čę©Š®ČĘ/;  # 1250 -> iso8859-2
65          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;          $s=~tr/¹©šŠčČęĘ¾®/sSdDcCcCzZ/;
66    
67          my $l2_map = Unicode::Map8->new("ISO-8859-2") || die;          my $swish_query;
68          my $us = Unicode::String->new();  
69            if (defined(param('max_hits'))) {
70                    $max_hits = param('max_hits');
71            }
72    
73            my ( $index_path, $result_coderef );
74    
75            if (param('index') eq 'title') {
76    
77                    $result_coderef = sub {
78                            my $hit = shift || die;
79                            my $naslov = $hit->property('swishtitle');
80                            from_to($naslov, 'utf-8', 'iso-8859-2');
81                            $naslov = FormatResult::highlite_words(\$naslov, \@hl_words);
82                            print "<tt><a href=\"$url",$hit->property('swishdocpath'),"\">NN",$hit->property('god'),"/",$hit->property('br'),"</a> ",$hit->property('nr')," </tt> $naslov [",$hit->property('swishrank'),"]<br>\n";
83                    };
84    
85                    $index_path = "$dir/swish/nn.index";
86                    $swish_query = "naslov_czs=($s)";
87                    if (param('god_limit')) {
88                            $swish_query .= " and god=".int(param('god')) if (param('god'));
89                    }
90    
91            } else {
92                    # search in full text
93    
94                    $result_coderef = sub {
95                            my $hit = shift || die;
96    
97          my $sh = SWISH->connect('Fork',                          my $path = $hit->property('swishdocpath');
98                  prog     => "$dir/swish-e",                          if ($file2title{$path}) {
99                  indexes  => "$dir/nn.index",                                  my ($god,$br,$nr,undef,$naslov) = split(/ /,$file2title{$path},5);
100                  properties  => [qw/god br nr/],                                  $naslov = FormatResult::highlite_words(\$naslov, \@hl_words);
101                  results  => sub {                                  from_to($naslov, 'utf-8', 'iso-8859-2');
102                          my ($sh,$hit) = @_;                                  print "<tt><a href=\"$url",$path,"\">NN$god/$br</a> $nr</tt> $naslov [",$hit->property('swishrank'),"]<br>\n";
103    
104                          $us->utf8($hit->swishtitle);                          } else {
105                                    print "<!-- error! can't find $path -->\n";
106                          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";                          }
107    
108  #                       print $_[1]->as_string,"<br>\n";                  };
109  #                       my @fields = $hit->field_names;  
110  #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;                  $index_path = "$dir/swish/sluzbeno.index";
111                  },                  $swish_query = $s;
112                  maxhits => param('max_hits') || $max_hits,                  if (param('god_limit')) {
113          );                          $swish_query .= " and swishdocpath=".int(param('god')) if (param('god'));
114                    }
115    
116            }
117    
118          die $SWISH::errstr unless $sh;          print "<!-- swish query: $swish_query -->";
119    
120          $hits = $sh->query("naslov_czs=($s)");          my $swish = SWISH::API->new( $index_path );
121            $swish->abort_last_error if $swish->Error;
122    
123            my $results = $swish->query($swish_query);
124    
125            my $hits = $results->hits;
126    
127          if ($hits > 0) {          if ($hits > 0) {
128                  print p,hr,"Prikazujem $hits zakona (maks. ",param('max_hits') || $max_hits,")... <small>($s)</small>";                  my $i = 1;
129                    while ( my $hit = $results->next_result ) {
130                            $result_coderef->( $hit );
131                            last if $i++ == $max_hits;
132                    }
133    
134                    print p,hr,"Pronašeno $hits zakona";
135                    print " iz godine ",param('god') if (param('god_limit'));
136                    print " (prikazano prvih $max_hits)... " if ($max_hits);
137                    print " <small>[$s]</small>";
138          } else {          } else {
139                  print p,"Nije našen niti jedan zakon... <small>($s, ",$sh->errstr,")</small>";                  print p,"Nije našen niti jedan zakon... <small>[$s, ",$swish->error_string,"]</small>";
140          }          }
141  } else {  } else {
142          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>');          my $dir=$0;
143          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.");          $dir=~s,(^.*?)/[^/]+$,$1,g;
144            open(HELP, "$dir/nn-help.html") || die "can't open '$dir/nn-help.html'";
145            while(<HELP>) {
146                    print;
147            }
148            close(HELP);
149  }  }
150    
151    untie %file2title;
Legend:
Removed from v.78  
changed lines
  Added in v.106
  ViewVC Help
Powered by ViewVC 1.1.26