/[webpac2]/Webpacus/lib/Webpacus/Controller/Search.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 /Webpacus/lib/Webpacus/Controller/Search.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 313 - (show annotations)
Wed Dec 21 22:18:56 2005 UTC (18 years, 4 months ago) by dpavlin
File size: 5003 byte(s)
fix grep { qr// } which doesn't work (why? perl v5.8.4) [0.25]

1 package Webpacus::Controller::Search;
2
3 use strict;
4 use warnings;
5 use base 'Catalyst::Controller';
6
7 use Data::Dumper;
8
9 use lib '/data/webpac2/lib';
10 use WebPAC::Search::Estraier 0.03;
11
12
13 =head1 NAME
14
15 Webpacus::Controller::Search - Search WebPAC data
16
17 =head1 SYNOPSIS
18
19 See L<WebPAC>, L<Webpacus>
20
21 =head1 DESCRIPTION
22
23 Catalyst Controller for search fields Hyper Estraier
24
25 =head1 METHODS
26
27 =over 4
28
29 =item default
30
31 =cut
32
33 sub default : Private {
34 my ( $self, $c ) = @_;
35
36 $c->log->debug("default search got param: ".Dumper($c->req->params));
37
38 $c->stash->{template} = 'search.tt';
39 }
40
41 =item suggest
42
43 Returns results for URLs like C<search/suggest/FieldName>
44
45 It will return field from URL (C<FieldName> in example>) and use
46 same filed in paramerers (comming from form or URL) or if it doesn't
47 exist field named C<all>.
48
49 =cut
50
51 sub suggest : Regex('^search/suggest/*([^/]*)') {
52 my ( $self, $c ) = @_;
53
54 my $what = $c->request->snippets->[0];
55
56 my $log = $c->log;
57
58 my $webpac = $c->comp('Model::WebPAC');
59
60 my $q = $c->req->params->{$what} ||
61 $c->req->params->{all} || $c->response->body("no results");
62
63
64 $log->info("search for '$q' in $what\n");
65
66 my $max = $c->config->{'hits_for_suggest'};
67 if (! $max) {
68 $log->info("hits_for_suggest isn't defined, defaulting to 10");
69 $c->config->{'hits_for_suggest'} = 10;
70 $max = 10;
71 }
72
73 my @hits = $webpac->search(
74 phrase => $q,
75 max => $max,
76 get_attr => [ $what ],
77 );
78
79 my $used;
80 my @suggestions;
81
82 foreach my $res (@hits) {
83 my $v = $res->{ $what } || next;
84 next if ($used->{ $v }++);
85 push @suggestions, $v;
86 }
87
88 $log->debug( ($#suggestions + 1) . " unique hits returned");
89
90 $c->response->body( $c->prototype->auto_complete_result( \@suggestions ) );
91 }
92
93
94 =item results
95
96 Returns results for search query
97
98 =cut
99
100 sub results : Local {
101 my ( $self, $c ) = @_;
102
103 my $params = $c->req->params;
104
105 # do full-page refresh for clients without JavaScript
106 $c->stash->{results} = $c->subreq('/search/results/ajax', {}, $params);
107 $c->stash->{template} = 'search.tt';
108 }
109
110
111 =item results_ajax
112
113 Private method which uses C<Model::WebPAC> and returns results for search
114 query It generatets just I<inner> HTML for results div, so it has C<_ajax>
115 in name.
116
117 =cut
118
119 # specify all Hyper Estraier operators which should stop this module
120 # from splitting search query and joining it with default operator
121 my $hest_op_regex = '(:?\[(:?BW|EW|RX)\]|AND|OR|ANDNOT)';
122
123 sub results_ajax : Path( 'results/ajax' ) {
124 my ( $self, $c ) = @_;
125
126 my $params = $c->req->params;
127 my $webpac = $c->comp('Model::WebPAC');
128 my $log = $c->log;
129
130 $log->debug("results got params: " . Dumper( $params ) );
131
132 if (! $params->{_page} || $params->{_page} < 1) {
133 $params->{_page} = 1;
134 $log->warn("fixed _page parametar to 1");
135 }
136
137 my @attr;
138 my @words;
139 # default operator to join fields/words
140 my $operator = 'AND';
141
142 foreach my $f (keys %{ $params }) {
143
144 next if ($f =~ m/^_/o);
145
146 my $v = $params->{$f} || next;
147
148 if (my $op = $params->{ '_' . $f}) {
149 if ($v =~ /$hest_op_regex/) {
150 # don't split words if there is Hyper Estraier
151 # operator in them
152 push @words, $v;
153 } else {
154 push @words, join(" $op ", split(/\s+/, $v) );
155 }
156 } else {
157 push @words, $v;
158 }
159
160 next if ($f eq 'all'); # don't add_attr for magic field all
161
162 if ($v !~ /\s/) {
163 push @attr, "$f ISTRINC $v";
164 } else {
165 map {
166 push @attr, "$f ISTRINC $_";
167 } grep { ! /$hest_op_regex/ } split(/\s+/, $v);
168 }
169 }
170
171 if ($params->{_database}) {
172 my $type = $c->config->{hyperstraier}->{type} || 'search';
173 my $attr;
174 if (ref($params->{_database}) eq 'ARRAY') {
175 # FIXME do we need to add $ at end?
176 $attr .= '(' . join("|",@{$params->{_database}}) . ')';
177 } else {
178 $attr .= $params->{_database};
179 }
180 push @attr, '@uri STRRX /' . $type . '/' . $attr . '/';
181 }
182
183 my $q = join(" $operator ", @words);
184
185 my $template = $params->{'_template'} || $c->config->{webpac}->{template};
186
187 $log->die("can't find _template or default from configuration!") unless ($template);
188
189 my $hits_on_page = $c->config->{'hyperestraier'}->{'hits_on_page'} || 10;
190
191 $log->debug("using template $template to produce $hits_on_page results");
192
193 $c->stash->{html_results} = sub {
194 my $res = $webpac->search(
195 phrase => $q,
196 template => $template,
197 add_attr => \@attr,
198 get_attr => [ '@uri' ],
199 max => $hits_on_page,
200 page => $params->{'_page'},
201 );
202 # $log->debug("controller got " . ( $#{$res} + 1 ) . " results for '$q' " . Dumper( $res ));
203 return $res;
204 };
205
206 $c->stash->{phrase} = $q;
207 $c->stash->{attr} = \@attr;
208 $c->stash->{page} = $params->{'_page'};
209 $c->stash->{hits_on_page} = $hits_on_page;
210
211 $c->stash->{template} = 'results.tt';
212
213 }
214
215 =item record
216
217 forwarded to C</editor/record>
218
219 =cut
220
221 sub record : Local {
222 my ( $self, $c ) = @_;
223
224 $c->forward( '/editor/record' );
225 }
226
227 =back
228
229 =head1 AUTHOR
230
231 Dobrica Pavlinusic C<< <dpavlin@rot13.org> >>
232
233 =head1 LICENSE
234
235 This library is free software, you can redistribute it and/or modify
236 it under the same terms as Perl itself.
237
238 =cut
239
240 1;

  ViewVC Help
Powered by ViewVC 1.1.26