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

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