/[webpac]/trunk/WebPac.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/WebPac.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (show annotations)
Sun Feb 16 22:41:37 2003 UTC (16 years, 9 months ago) by dpavlin
File size: 4373 byte(s)
added configuration file with database descriptions,
moved isis.xml definition file in separate directory (in preparation for MARK),
support for different encodings in different files,
various fixes, improvements and badly written parts which will change ;-)

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::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
10 use DBI;
11
12 use lib '..';
13 use index_DBI;
14 use back2html;
15
16 # configuration options
17 # FIX: they really should go in configuration file!
18 my $TEMPLATE_PATH = '/data/webpac/template_html';
19 my $CHARSET = 'ISO-8859-2';
20 my $SWISH = '/usr/bin/swish-e';
21 my $INDEX = '/data/webpac/index/isis.index';
22 my $MAX_HITS = 500;
23 my $ON_PAGE = 10;
24
25
26 sub setup {
27 my $self = shift;
28 $self->tmpl_path($TEMPLATE_PATH);
29 $self->run_modes(
30 'search' => 'show_search_form',
31 'results' => 'show_results_list',
32 # 'user' => 'show_user_detail',
33 'index' => 'show_index',
34 );
35 $self->start_mode('search');
36 $self->mode_param('rm');
37
38 $self->header_props(-charset=>$CHARSET);
39 }
40
41 sub show_search_form {
42 my $self = shift;
43
44 # Get the CGI.pm query object
45 my $q = $self->query();
46
47 my $tmpl = $self->load_tmpl('search.html');
48 my $html = $tmpl->output;
49
50 my $fif = new HTML::FillInForm;
51
52 return $fif->fill(scalarref => \$html, fobject => $q,
53 target => 'search');
54 }
55
56 sub show_results_list {
57 my $self = shift;
58
59 my $q = $self->query();
60
61 my @swish_results; # results from swish
62
63 # load template for this page
64
65 my @s_arr; # all queries are located here
66
67 for(my $i = 1; $i <=10; $i++) {
68
69 return show_index($self, $i) if ($q->param("f".$i."_index"));
70 next if (! $q->param("f$i"));
71 next if (! $q->param("v$i"));
72
73 # re-write query from +/- to and/and not
74 my $s;
75 my $search = $q->param("v$i");
76 while ($search =~ s/\s*("[^"]+")\s*/ /) {
77 $s .= "$1 ";
78 }
79 $search =~ s/^\s+//;
80 $search =~ s/\s+$//;
81
82 foreach (split(/\s+/,$search)) {
83 if (m/^([+-])(\S+)/) {
84 $s.= ($s) ? "and " : "";
85 $s.="not " if ($1 eq "-");
86 $s.="$2* ";
87 } else {
88 $s.="$_* ";
89 }
90 }
91
92 push @s_arr,$q->param("f$i")."_swish=($s)";
93 }
94
95 my $tmpl = $self->load_tmpl('results.html');
96
97 # call swish
98 my $sh = SWISH->connect('Fork',
99 prog => $SWISH,
100 indexes => $INDEX,
101 properties => [qw/swishdocpath swishrank swishtitle headline html/],
102 results => sub {
103 my ($sh,$hit) = @_;
104
105 push @swish_results, {
106 nr => ($#swish_results + 2),
107 path => $hit->swishdocpath,
108 headline => from_utf8({ -string => $hit->headline, -charset => $CHARSET }),
109 html => back2html(from_utf8({ -string => $hit->html, -charset => $CHARSET })),
110 rank => $hit->swishrank };
111
112 },
113 #startnum => 0,
114 maxhits => $MAX_HITS,
115 );
116
117 die $SWISH::errstr unless $sh;
118
119 my $hits = $sh->query(join(" and ",@s_arr)) || 0; # FIX: and/or
120
121 $tmpl->param('hits',$hits);
122 $tmpl->param('search',join(" and ",@s_arr));
123
124 # create a Pager object
125 my $pager = HTML::Pager->new(
126 # required parameters
127 query => $q,
128 get_data_callback => sub {
129 my ($offset, $rows) = @_;
130
131 my @result;
132 for (my $i=0; $i<$rows; $i++) {
133 push @result, $swish_results[$offset+$i] if $swish_results[$offset+$i];
134 }
135 return \@result;
136 },
137 rows => $hits,
138 page_size => $ON_PAGE,
139 # some optional parameters
140 persist_vars => [
141 'rm',
142 'f1', 'v1',
143 'f2', 'v2',
144 'f3', 'v3',
145 'f4', 'v4',
146 'f5', 'v5',
147 'f6', 'v6',
148 'f7', 'v7',
149 'f8', 'v8',
150 'f9', 'v9',
151 ],
152 #cell_space_color => '#000000',
153 #cell_background_color => '#ffffff',
154 #nav_background_color => '#dddddd',
155 #javascript_presubmit => 'last_minute_javascript()',
156 debug => 1,
157 template => $tmpl,
158 );
159
160 my $html = $pager->output;
161
162 return $html;
163 }
164
165 sub show_index {
166 my $self = shift;
167 my $i = shift; # field number
168
169 my $q = $self->query();
170
171 my $field = $q->param("f$i");
172 my $limit = $q->param("v$i");
173
174 my $html;
175
176 my $index = new index_DBI();
177
178 my $total = $index->check($field);
179 if (! $total) {
180 my $tmpl = $self->load_tmpl('no_index.html');
181 $tmpl->param('field',$field);
182 $html = $tmpl->output;
183 return $html;
184 }
185
186 my $tmpl = $self->load_tmpl('index_res.html');
187 $tmpl->param('field',$field);
188 $tmpl->param('limit',$limit);
189 $tmpl->param('total',$total);
190
191 my $pager = HTML::Pager->new(
192 query => $q,
193 get_data_callback => sub {
194 my ($offset, $rows) = @_;
195
196 my @result = $index->fetch($field,'item',$limit, $offset, $rows);
197 return \@result;
198 },
199 rows => $total,
200 page_size => $ON_PAGE,
201 persist_vars => [
202 'rm',
203 "f$i", "v$i", "f".$i."_index",
204 'offset',
205 ],
206 debug => 1,
207 template => $tmpl,
208 );
209
210 return $pager->output;
211 }
212
213 1;

Properties

Name Value
cvs2svn:cvs-rev 1.6

  ViewVC Help
Powered by ViewVC 1.1.26