/[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 7 - (show annotations)
Sat Jan 11 16:44:03 2003 UTC (16 years, 10 months ago) by dpavlin
File size: 3361 byte(s)
major modifications to produce first (non-working) version of Web CGI
interface.

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;

Properties

Name Value
cvs2svn:cvs-rev 1.1

  ViewVC Help
Powered by ViewVC 1.1.26