/[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 9 - (hide annotations)
Sat Jan 11 19:55:30 2003 UTC (21 years, 2 months ago) by dpavlin
File size: 3666 byte(s)
renamed "old" index to swish, and introduced index which is -- index;
implemented using PostgreSQL for now.

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

Properties

Name Value
cvs2svn:cvs-rev 1.2

  ViewVC Help
Powered by ViewVC 1.1.26