/[webpac]/branches/fsb/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

Annotation of /branches/fsb/WebPac.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (hide annotations)
Sat Jul 5 21:35:44 2003 UTC (20 years, 8 months ago) by dpavlin
Original Path: trunk/WebPac.pm
File size: 5304 byte(s)
more fields and slight speedup

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

Properties

Name Value
cvs2svn:cvs-rev 1.16

  ViewVC Help
Powered by ViewVC 1.1.26