/[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 10 - (hide annotations)
Thu Jan 16 17:35:54 2003 UTC (16 years, 11 months ago) by dpavlin
File size: 3596 byte(s)
bunch of changes: make design more modular, implement index (partial
implementation) and other small and big changes

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

Properties

Name Value
cvs2svn:cvs-rev 1.3

  ViewVC Help
Powered by ViewVC 1.1.26