git.rot13.org Git - webpac/blob - WebPac.pm

   1 package WebPac;
   2
   3 use base 'CGI::Application';
   4 use strict;
   5
   6 use HTML::Pager;
   7 use HTML::FillInForm;
   8 use SWISH;
   9 use Text::Iconv;
  10 use DBI;
  11 use Config::IniFiles;
  12 use Text::Unaccent;
  13
  14 use lib '..';
  15 use index_DBI;
  16 use back2html;
  17
  18
  19 # read global.conf configuration
  20 my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";
  21
  22 # configuration options from global.conf
  23 my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";
  24 my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';
  25 my $SWISH = $cfg_global->val('webpac', 'swish') || '/usr/bin/swish-e';
  26 my $INDEX = $cfg_global->val('webpac', 'index') || die "need index in global.conf, section webpac";
  27 my $MAX_HITS = $cfg_global->val('webpac', 'max_hits') || 0;
  28 my $ON_PAGE =$cfg_global->val('webpac', 'on_page') || 10;
  29 my $MIN_WILDCARD =$cfg_global->val('webpac', 'min_wildcard') || 1;
  30
  31
  32 Text::Iconv->raise_error(0);     # Conversion errors raise exceptions
  33
  34 my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);
  35
  36
  37 sub setup {
  38         my $self = shift;
  39         $self->tmpl_path($TEMPLATE_PATH);
  40         $self->run_modes(
  41                 'search' => 'show_search_form',
  42                 'results' => 'show_results_list',
  43 #               'user' => 'show_user_detail',
  44                 'index' => 'show_index',
  45         );
  46         $self->start_mode('search');
  47         $self->mode_param('rm');
  48
  49         $self->header_props(-charset=>$CHARSET);
  50 }
  51
  52 sub show_search_form {
  53         my $self = shift;
  54
  55         # Get the CGI.pm query object
  56         my $q = $self->query();
  57
  58         my $tmpl = $self->load_tmpl('search.html');
  59         my $html = $tmpl->output;
  60
  61         my $fif = new HTML::FillInForm;
  62
  63         return $fif->fill(scalarref => \$html, fobject => $q,
  64                 target => 'search');
  65 }
  66
  67 sub show_results_list {
  68         my $self = shift;
  69
  70         my $q = $self->query();
  71
  72         my @swish_results;      # results from swish
  73
  74         # load template for this page
  75
  76         my @s_arr;      # all queries are located here
  77
  78         my @path_arr = $q->param('path');
  79         my $full = $q->param('full');
  80
  81         my @persist_vars = ( 'rm' );
  82
  83         for(my $i = 1; $i <=30; $i++) {
  84
  85                 return show_index($self, $i) if ($q->param("f".$i."_index"));
  86
  87                 next if (! $q->param("v$i"));
  88                 next if (! $q->param("f$i"));
  89
  90                 push @persist_vars, "f$i";
  91                 push @persist_vars, "v$i";
  92
  93                 # re-write query from +/- to and/and not
  94                 my @param_vals = $q->param("v$i");
  95                 my @swish_q;
  96                 while (my $search = shift @param_vals) {
  97                         my $s;
  98                         # remove accents
  99                         $search = unac_string($CHARSET,$search);
 100                         while ($search =~ s/\s*("[^"]+")\s*/ /) {
 101                                 $s .= "$1 ";
 102                         }
 103                         $search =~ s/^\s+//;
 104                         $search =~ s/\s+$//;
 105
 106                         foreach (split(/\s+/,$search)) {
 107                                 if (m/^([+-])(\S+)/) {
 108                                         $s.= ($s) ? "and " : "";
 109                                         $s.="not " if ($1 eq "-");
 110                                         $s.="$2* ";
 111                                 } elsif (m/(and|or|not)/i) {
 112                                         $s.="$_ ";
 113                                 # don't add * to words with less than x chars
 114                                 } elsif (length($_) <= $MIN_WILDCARD) {
 115                                         $s.="$_ ";
 116                                 } else {
 117                                         $s.="$_* ";
 118                                 }
 119                         }
 120                         $s =~ s/\*+/*/g;
 121                         push @swish_q,$s;
 122                 }
 123                 # FIXME default operator for multi-value fields is or. There is
 124                 # no way to change it, except here for now. Is there need?
 125                 push @s_arr, $q->param("f$i")."_swish=(".join(" or ",@swish_q).")";
 126         }
 127
 128         my $tmpl = $self->load_tmpl('results.html');
 129
 130         sub esc_html {
 131                 my $html = shift;
 132                 $html =~ s/</&lt;/g;
 133                 $html =~ s/>/&gt;/g;
 134                 return $html;
 135         }
 136
 137         # call swish
 138         my $sh = SWISH->connect('Fork',
 139                 prog     => $SWISH,
 140                 indexes  => $INDEX,
 141                 properties  => [qw/swishdocpath swishrank swishtitle headline html/],
 142                 results  => sub {
 143                         my ($sh,$hit) = @_;
 144
 145                         push @swish_results, {
 146                                 nr => ($#swish_results + 2),
 147                                 path => $hit->swishdocpath,
 148                                 headline => esc_html($from_utf8->convert($hit->headline)),
 149                                 html => back2html($from_utf8->convert($hit->html)),
 150                                 rank => $hit->swishrank };
 151
 152                 },
 153                 #startnum => 0,
 154                 maxhits => $MAX_HITS
 155         );
 156
 157         die $SWISH::errstr unless $sh;
 158         # construct swish query
 159         my $sw_q = join(" and ",@s_arr);
 160         if (@path_arr && $q->param('show_full')) {
 161                 $sw_q .= "and (swishdocpath=\"";
 162                 $sw_q .= join("\" or swishdocpath=\"",@path_arr);
 163                 $sw_q .= "\")";
 164                 $tmpl->param('full',1); # show full records
 165         }
 166
 167         my $hits = $sh->query($sw_q);
 168
 169         $tmpl->param('hits',$hits);
 170         $tmpl->param('search',$sw_q);
 171
 172         $tmpl->param('PAGER_offset',$q->param("PAGER_offset") || 0);
 173         $tmpl->param('last_PAGER_offset',$q->param("last_PAGER_offset") || 0);
 174
 175         # create a Pager object
 176         my $pager = HTML::Pager->new(
 177                 # required parameters
 178                 query => $q,
 179                 get_data_callback => sub {
 180                         my ($offset, $rows) = @_;
 181
 182                         my @result;
 183                         for (my $i=0; $i<$rows; $i++) {
 184                                 my $r = $swish_results[$offset+$i];
 185                                 if ($r && $q->param('show_full')) {
 186                                         push @result, $r;
 187                                 } elsif ($r) {
 188                                         # if not full output, skip html
 189                                         delete $r->{html};
 190                                         push @result, $r;
 191                                 }
 192                         }
 193                         return \@result;
 194                 },
 195                 rows => $hits,
 196                 page_size => $ON_PAGE,
 197                 # some optional parameters
 198                 persist_vars => [ @persist_vars ],
 199                 #cell_space_color => '#000000',
 200                 #cell_background_color => '#ffffff',
 201                 #nav_background_color => '#dddddd',
 202                 #javascript_presubmit => 'last_minute_javascript()',
 203                 debug => 1,
 204                 template => $tmpl,
 205         );
 206
 207         my $html = $pager->output;
 208
 209         return $html;
 210 }
 211
 212 sub show_index {
 213         my $self = shift;
 214         my $i = shift;          # field number
 215
 216         my $q = $self->query();
 217
 218         my $field = $q->param("f$i");
 219         my $limit = $q->param("v$i");
 220
 221         my $html;
 222
 223         my $index = new index_DBI(
 224                 $cfg_global->val('global', 'dbi_dbd'),
 225                 $cfg_global->val('global', 'dbi_dsn'),
 226                 $cfg_global->val('global', 'dbi_user'),
 227                 $cfg_global->val('global', 'dbi_passwd') || ''
 228         );
 229
 230         my $total = $index->check($field);
 231         if (! $total) {
 232                 my $tmpl = $self->load_tmpl('no_index.html');
 233                 $tmpl->param('field',$field);
 234                 $html = $tmpl->output;
 235                 return $html;
 236         }
 237
 238         my $tmpl = $self->load_tmpl('index_res.html');
 239         $tmpl->param('field',$field);
 240         $tmpl->param('limit',$limit);
 241         $tmpl->param('total',$total);
 242
 243 # FIXME I should set offset and leave out limit from fetch!!
 244 #       if (! $q->param("PAGER_offset") {
 245 #               $q->param("Pager_offet)
 246 #       }
 247
 248         my $pager = HTML::Pager->new(
 249                 query => $q,
 250                 get_data_callback => sub {
 251                         my ($offset, $rows) = @_;
 252
 253                         my @result = $index->fetch($field,'item',$limit, $offset, $rows);
 254                         return \@result;
 255                 },
 256                 rows => $total,
 257                 page_size => $ON_PAGE,
 258                 persist_vars => [
 259                         'rm',
 260                         "f$i", "v$i", "f".$i."_index",
 261                         'offset',
 262                         ],
 263                 debug => 1,
 264                 template => $tmpl,
 265         );
 266
 267         return $pager->output;
 268 }
 269
 270 1;