/[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

Annotation of /trunk/WebPac.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide 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 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 10 use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
10 dpavlin 9 use DBI;
11 dpavlin 7
12 dpavlin 11 use lib '..';
13     use index_DBI;
14 dpavlin 13 use back2html;
15 dpavlin 11
16 dpavlin 7 # 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 dpavlin 13 my $SWISH = '/usr/bin/swish-e';
21 dpavlin 7 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 dpavlin 9 # 'user' => 'show_user_detail',
33     'index' => 'show_index',
34 dpavlin 7 );
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 dpavlin 9 return show_index($self, $i) if ($q->param("f".$i."_index"));
70     next if (! $q->param("f$i"));
71 dpavlin 7 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 dpavlin 9 push @s_arr,$q->param("f$i")."_swish=($s)";
93 dpavlin 7 }
94    
95 dpavlin 9 my $tmpl = $self->load_tmpl('results.html');
96    
97 dpavlin 7 # call swish
98     my $sh = SWISH->connect('Fork',
99     prog => $SWISH,
100     indexes => $INDEX,
101 dpavlin 13 properties => [qw/swishdocpath swishrank swishtitle headline html/],
102 dpavlin 7 results => sub {
103     my ($sh,$hit) = @_;
104    
105     push @swish_results, {
106     nr => ($#swish_results + 2),
107     path => $hit->swishdocpath,
108 dpavlin 13 headline => from_utf8({ -string => $hit->headline, -charset => $CHARSET }),
109     html => back2html(from_utf8({ -string => $hit->html, -charset => $CHARSET })),
110 dpavlin 7 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 dpavlin 9 sub show_index {
166     my $self = shift;
167     my $i = shift; # field number
168    
169     my $q = $self->query();
170    
171 dpavlin 11 my $field = $q->param("f$i");
172     my $limit = $q->param("v$i");
173    
174 dpavlin 9 my $html;
175    
176 dpavlin 11 my $index = new index_DBI();
177 dpavlin 9
178 dpavlin 12 my $total = $index->check($field);
179     if (! $total) {
180 dpavlin 11 my $tmpl = $self->load_tmpl('no_index.html');
181     $tmpl->param('field',$field);
182     $html = $tmpl->output;
183     return $html;
184     }
185 dpavlin 9
186 dpavlin 12 my $tmpl = $self->load_tmpl('index_res.html');
187     $tmpl->param('field',$field);
188     $tmpl->param('limit',$limit);
189     $tmpl->param('total',$total);
190 dpavlin 11
191 dpavlin 12 my $pager = HTML::Pager->new(
192     query => $q,
193     get_data_callback => sub {
194     my ($offset, $rows) = @_;
195 dpavlin 11
196 dpavlin 12 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 dpavlin 11
210 dpavlin 12 return $pager->output;
211 dpavlin 9 }
212    
213 dpavlin 7 1;

Properties

Name Value
cvs2svn:cvs-rev 1.6

  ViewVC Help
Powered by ViewVC 1.1.26