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 Unicode::String qw(utf8 utf16);
  10 require Unicode::Map8;
  11
  12 # configuration options
  13 # FIX: they really should go in configuration file!
  14 my $TEMPLATE_PATH = '/data/webpac/template_html';
  15 my $CHARSET = 'ISO-8859-2';
  16 my $SWISH = '/data/swish/swish-e';
  17 my $INDEX = '/data/webpac/index/isis.index';
  18 my $MAX_HITS = 500;
  19 my $ON_PAGE = 10;
  20
  21
  22 sub setup {
  23         my $self = shift;
  24         $self->tmpl_path($TEMPLATE_PATH);
  25         $self->run_modes(
  26                 'search' => 'show_search_form',
  27                 'results' => 'show_results_list',
  28 #               'user' => 'show_user_detail'
  29         );
  30         $self->start_mode('search');
  31         $self->mode_param('rm');
  32
  33         $self->header_props(-charset=>$CHARSET);
  34 }
  35
  36 sub show_search_form {
  37         my $self = shift;
  38
  39         # Get the CGI.pm query object
  40         my $q = $self->query();
  41
  42         my $tmpl = $self->load_tmpl('search.html');
  43         my $html = $tmpl->output;
  44
  45         my $fif = new HTML::FillInForm;
  46
  47         return $fif->fill(scalarref => \$html, fobject => $q,
  48                 target => 'search');
  49 }
  50
  51 sub show_results_list {
  52         my $self = shift;
  53
  54         my $q = $self->query();
  55
  56         my @swish_results;      # results from swish
  57
  58         # load template for this page
  59         my $tmpl = $self->load_tmpl('results.html');
  60
  61         my @s_arr;      # all queries are located here
  62
  63         for(my $i = 1; $i <=10; $i++) {
  64
  65                 last if (! $q->param("f$i"));
  66                 next if (! $q->param("v$i"));
  67
  68                 # re-write query from +/- to and/and not
  69                 my $s;
  70                 my $search = $q->param("v$i");
  71                 while ($search =~ s/\s*("[^"]+")\s*/ /) {
  72                         $s .= "$1 ";
  73                 }
  74                 $search =~ s/^\s+//;
  75                 $search =~ s/\s+$//;
  76
  77                 foreach (split(/\s+/,$search)) {
  78                         if (m/^([+-])(\S+)/) {
  79                                 $s.= ($s) ? "and " : "";
  80                                 $s.="not " if ($1 eq "-");
  81                                 $s.="$2* ";
  82                         } else {
  83                                 $s.="$_* ";
  84                         }
  85                 }
  86
  87                 push @s_arr,$q->param("f$i")."=($s)";
  88         }
  89
  90         my $l2_map = Unicode::Map8->new($CHARSET) || die;
  91         my $us = Unicode::String->new();
  92
  93         # call swish
  94         my $sh = SWISH->connect('Fork',
  95                 prog     => $SWISH,
  96                 indexes  => $INDEX,
  97                 #properties  => [qw/god br nr/],
  98                 results  => sub {
  99                         my ($sh,$hit) = @_;
 100
 101                         $us->utf8($hit->swishtitle);
 102
 103                         push @swish_results, {
 104                                 nr => ($#swish_results + 2),
 105                                 path => $hit->swishdocpath,
 106                                 title => $l2_map->to8($us->utf16),
 107                                 rank => $hit->swishrank };
 108
 109 #                       my @fields = $hit->field_names;
 110 #                       print "Field '$_' = '", $hit->$_, "'<br>\n" for sort @fields;
 111                 },
 112                 #startnum => 0,
 113                 maxhits => $MAX_HITS,
 114         );
 115
 116         die $SWISH::errstr unless $sh;
 117
 118         my $hits = $sh->query(join(" and ",@s_arr)) || 0;       # FIX: and/or
 119
 120         $tmpl->param('hits',$hits);
 121         $tmpl->param('search',join(" and ",@s_arr));
 122
 123         # create a Pager object
 124         my $pager = HTML::Pager->new(
 125                 # required parameters
 126                 query => $q,
 127                 get_data_callback => sub {
 128                         my ($offset, $rows) = @_;
 129
 130                         my @result;
 131                         for (my $i=0; $i<$rows; $i++) {
 132                                 push @result, $swish_results[$offset+$i] if $swish_results[$offset+$i];
 133                         }
 134                         return \@result;
 135                 },
 136                 rows => $hits,
 137                 page_size => $ON_PAGE,
 138                 # some optional parameters
 139                 persist_vars => [
 140                         'rm',
 141                         'f1', 'v1',
 142                         'f2', 'v2',
 143                         'f3', 'v3',
 144                         'f4', 'v4',
 145                         'f5', 'v5',
 146                         'f6', 'v6',
 147                         'f7', 'v7',
 148                         'f8', 'v8',
 149                         'f9', 'v9',
 150                         ],
 151                 #cell_space_color => '#000000',
 152                 #cell_background_color => '#ffffff',
 153                 #nav_background_color => '#dddddd',
 154                 #javascript_presubmit => 'last_minute_javascript()',
 155                 debug => 1,
 156                 template => $tmpl,
 157         );
 158
 159         my $html = $pager->output;
 160
 161         return $html;
 162 }
 163
 164 1;