Webpacus/Controller/Search.pm

package Webpacus::Controller::Search;

use strict;
use warnings;
use base 'Catalyst::Controller';

use lib '/data/webpac2/lib';
use WebPAC::Search::Estraier 0.03;
use Data::SpreadPagination;


=head1 NAME

Webpacus::Controller::Search - Search WebPAC data

=head1 SYNOPSIS

See L<WebPAC>, L<Webpacus>

=head1 DESCRIPTION

Catalyst Controller for search fields Hyper Estraier

=head1 METHODS

=over 4

=item default

=cut

sub default : Private {
    my ( $self, $c ) = @_;

        $c->log->dumper($c->req->params, 'params');

    $c->stash->{template} = 'search.tt';
}

=item suggest

Returns results for REST URIs like:

C<search/suggest?search=FieldName&show=TitleProper&FieldName=query%20string>

It will use C<search> field to filter results (and using additional
C<FieldName> as value of search) and return C<TitleProper> field
for results.

If C<search> field has magic value <all>, it will search over all data, not
just one specified field:

C<search/suggest?search=all&show=TitleProper&all=query%20string>

=cut

sub suggest : Local {
        my ( $self, $c ) = @_;

        my $search = $c->req->params->{search};
        my $show = $c->req->params->{show};

        my $log = $c->log;

        my $webpac = $c->comp('Model::WebPAC');
        #$c->log->dumper( $c->stash, 'stash' );
        $webpac->setup_site( $c->stash->{site} );

        my $q = $c->req->params->{ $search || 'all' } || $c->response->body("no results");

        $log->info("search for '$q' in $search and display $show\n");

        my $max = $c->config->{'hits_for_suggest'};
        if (! $max) {
                $log->info("hits_for_suggest isn't defined, defaulting to 10");
                $c->config->{'hits_for_suggest'} = 10;
                $max = 10;
        }

        $c->forward('filter_database');

        my $hits = $webpac->search(
                phrase => $q,
                add_attr => $c->stash->{attr},
                get_attr => [ $show ],
                max => $max,
        );

        my $used;
        my @suggestions;

        foreach my $res (@{$hits}) {
                my $v = $res->{ $show } || next;
                next if ($used->{ $v }++);
                push @suggestions, $v;
        }

        $log->debug( ($#suggestions + 1) . " unique hits returned");

        $c->response->body( $c->prototype->auto_complete_result( \@suggestions ) );
}


=item results

Returns results for search query

=cut

sub results : Local {
        my ( $self, $c ) = @_;

        my $params = $c->req->params;

        # do full-page refresh for clients without JavaScript
        $c->stash->{results} = $c->subreq('/search/results/ajax', {}, $params);
        $c->stash->{template} = 'search.tt';
}


=item results_ajax

Private method which uses C<Model::WebPAC> and returns results for search
query It generatets just I<inner> HTML for results div, so it has C<_ajax>
in name.

=cut

# specify all Hyper Estraier operators which should stop this module
# from splitting search query and joining it with default operator
my $hest_op_regex = '(:?\[(:?BW|EW|RX)\]|AND|OR|ANDNOT)';

sub results_ajax : Path( 'results/ajax' ) {
        my ( $self, $c ) = @_;

        my $params = $c->req->params;
        my $webpac = $c->comp('Model::WebPAC');
        $webpac->setup_site( $c->stash->{site} );
        my $log = $c->log;

        $log->dumper($params, 'params');

        if (! $params->{_page} || $params->{_page} < 1) {
                $params->{_page} = 1;
                $log->warn("fixed _page parametar to 1");
        }

        my @words;
        # default operator to join fields/words
        my $operator = 'AND';

        foreach my $f (keys %{ $params }) {

                next if ($f =~ m/^_/o);

                my $v = $params->{$f} || next;

                if (my $op = $params->{ '_' . $f}) {
                        if ($v =~ /$hest_op_regex/) {
                                # don't split words if there is Hyper Estraier
                                # operator in them
                                push @words, $v;
                        } else {
                                push @words, join(" $op ", split(/\s+/, $v) );
                        }
                } else {
                        push @words, $v;
                }

                next if ($f eq 'all');  # don't add_attr for magic field all

                if ($v !~ /\s/) {
                        push @{ $c->stash->{attr} }, "$f ISTRINC $v";
                } else {
                        map {
                                push @{ $c->stash->{attr} }, "$f ISTRINC $_";
                        } grep { ! /$hest_op_regex/ } split(/\s+/, $v);
                }
        }

    $c->forward('filter_database');

        my $q = join(" $operator ", @words);

        my $template = $params->{'_template'} || $c->config->{webpac}->{template};

        $log->die("can't find _template or default from configuration!") unless ($template);

        my $hits_on_page = $c->config->{'hyperestraier'}->{'hits_on_page'} || 10;

        $log->debug("using template $template to produce $hits_on_page results");

        $c->stash->{html_results} = $webpac->search( 
                        phrase => $q,
                        template => $template,
                        add_attr => $c->{stash}->{attr},
                        get_attr => [ '@uri' ],
                        max => $hits_on_page,
                        page => $params->{'_page'},
        );

        $c->stash->{hints} = $webpac->hints;

        $c->stash->{phrase} = $q;
        $c->stash->{page} = $params->{_page};
        $c->stash->{hits_on_page} = $hits_on_page;

        # create pager
        $c->stash->{pager} = new Data::SpreadPagination({
                totalEntries => $webpac->hints->{hit},
                entriesPerPage => $hits_on_page,
                currentPage => $params->{_page},
                maxPages => $c->config->{pager}->{max_pages} || 10,
        });

        my $site_uri_params = $params;

        map {
                delete( $site_uri_params->{$_} ) unless ( $site_uri_params->{$_} );
        } keys %{ $site_uri_params };

        $c->stash->{site_uri_params} = sub {

                my $s_params = $site_uri_params;

                $c->log->dumper( $s_params, 'original_params' );

                my $n_params = shift;
                foreach my $p (keys %{ $n_params }) {
                        if (! $n_params->{$p}) {
                                delete($s_params->{$p});
                        } else {
                                $s_params->{$p} = $n_params->{$p};
                        }
                }

                $c->log->dumper( $s_params, 'site_uri_params' );
                return $c->uri_for('results', $s_params)->as_string;
        };

        $c->stash->{template} = 'results.tt';

}

=item filter_database

Takes C<< $c->req->params >> and adds Hyper Estraier
filters for checked databases to C<< $c->stash->{attr} >>.

=cut

sub filter_database : Private {
        my ( $self, $c ) = @_;

        my $params = $c->req->params;

        if ($params->{_database}) {
                my $type = $c->config->{hyperstraier}->{type} || 'search';
                my $attr;
                if (ref($params->{_database}) eq 'ARRAY') {
                        # FIXME do we need to add $ at end?
                        $attr .= '(' . join("|",@{$params->{_database}}) . ')';
                } else {
                        $attr .= $params->{_database};
                }
                push @{ $c->stash->{attr} }, '@uri STRRX /' . $type . '/' . $attr . '/';
                $c->log->debug("filter_database: " . join(",", @{ $c->stash->{attr} }) );
        }


}

=item record

forwarded to C</editor/record>

=cut

sub record : Local {
        my ( $self, $c ) = @_;

        $c->detach( '/editor/record' );
}

=back

=head1 AUTHOR

Dobrica Pavlinusic C<< <dpavlin@rot13.org> >>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
1	dpavlin	109	package Webpacus::Controller::Search;
2
3			use strict;
4			use warnings;
5			use base 'Catalyst::Controller';
6
7			use lib '/data/webpac2/lib';
8	dpavlin	159	use WebPAC::Search::Estraier 0.03;
9	dpavlin	440	use Data::SpreadPagination;
10	dpavlin	109
11	dpavlin	153
12	dpavlin	109	=head1 NAME
13
14	dpavlin	155	Webpacus::Controller::Search - Search WebPAC data
15	dpavlin	109
16			=head1 SYNOPSIS
17
18	dpavlin	155	See L<WebPAC>, L<Webpacus>
19	dpavlin	109
20			=head1 DESCRIPTION
21
22	dpavlin	155	Catalyst Controller for search fields Hyper Estraier
23	dpavlin	109
24			=head1 METHODS
25
26			=over 4
27
28			=item default
29
30			=cut
31
32			sub default : Private {
33			my ( $self, $c ) = @_;
34	dpavlin	270
35	dpavlin	400	$c->log->dumper($c->req->params, 'params');
36	dpavlin	270
37	dpavlin	109	$c->stash->{template} = 'search.tt';
38			}
39
40			=item suggest
41
42	dpavlin	326	Returns results for REST URIs like:
43	dpavlin	109
44	dpavlin	326	C<search/suggest?search=FieldName&show=TitleProper&FieldName=query%20string>
45	dpavlin	155
46	dpavlin	326	It will use C<search> field to filter results (and using additional
47			C<FieldName> as value of search) and return C<TitleProper> field
48			for results.
49
50			If C<search> field has magic value <all>, it will search over all data, not
51			just one specified field:
52
53			C<search/suggest?search=all&show=TitleProper&all=query%20string>
54
55	dpavlin	109	=cut
56
57	dpavlin	326	sub suggest : Local {
58	dpavlin	143	my ( $self, $c ) = @_;
59	dpavlin	109
60	dpavlin	326	my $search = $c->req->params->{search};
61			my $show = $c->req->params->{show};
62	dpavlin	109
63	dpavlin	143	my $log = $c->log;
64	dpavlin	109
65	dpavlin	155	my $webpac = $c->comp('Model::WebPAC');
66	dpavlin	405	#$c->log->dumper( $c->stash, 'stash' );
67	dpavlin	399	$webpac->setup_site( $c->stash->{site} );
68	dpavlin	109
69	dpavlin	326	my $q = $c->req->params->{ $search \|\| 'all' } \|\| $c->response->body("no results");
70	dpavlin	109
71	dpavlin	326	$log->info("search for '$q' in $search and display $show\n");
72	dpavlin	143
73	dpavlin	155	my $max = $c->config->{'hits_for_suggest'};
74	dpavlin	143	if (! $max) {
75			$log->info("hits_for_suggest isn't defined, defaulting to 10");
76			$c->config->{'hits_for_suggest'} = 10;
77			$max = 10;
78			}
79	dpavlin	109
80	dpavlin	326	$c->forward('filter_database');
81
82	dpavlin	382	my $hits = $webpac->search(
83	dpavlin	155	phrase => $q,
84	dpavlin	326	add_attr => $c->stash->{attr},
85			get_attr => [ $show ],
86	dpavlin	155	max => $max,
87			);
88	dpavlin	109
89	dpavlin	143	my $used;
90			my @suggestions;
91
92	dpavlin	382	foreach my $res (@{$hits}) {
93	dpavlin	326	my $v = $res->{ $show } \|\| next;
94	dpavlin	143	next if ($used->{ $v }++);
95			push @suggestions, $v;
96			}
97
98			$log->debug( ($#suggestions + 1) . " unique hits returned");
99
100	dpavlin	228	$c->response->body( $c->prototype->auto_complete_result( \@suggestions ) );
101	dpavlin	109	}
102
103	dpavlin	153
104			=item results
105
106	dpavlin	270	Returns results for search query
107	dpavlin	153
108			=cut
109
110			sub results : Local {
111			my ( $self, $c ) = @_;
112
113	dpavlin	270	my $params = $c->req->params;
114
115	dpavlin	283	# do full-page refresh for clients without JavaScript
116			$c->stash->{results} = $c->subreq('/search/results/ajax', {}, $params);
117			$c->stash->{template} = 'search.tt';
118	dpavlin	270	}
119
120
121			=item results_ajax
122
123			Private method which uses C<Model::WebPAC> and returns results for search
124			query It generatets just I<inner> HTML for results div, so it has C<_ajax>
125			in name.
126
127			=cut
128
129			# specify all Hyper Estraier operators which should stop this module
130			# from splitting search query and joining it with default operator
131	dpavlin	313	my $hest_op_regex = '(:?\[(:?BW\|EW\|RX)\]\|AND\|OR\|ANDNOT)';
132	dpavlin	270
133			sub results_ajax : Path( 'results/ajax' ) {
134			my ( $self, $c ) = @_;
135
136			my $params = $c->req->params;
137	dpavlin	153	my $webpac = $c->comp('Model::WebPAC');
138	dpavlin	399	$webpac->setup_site( $c->stash->{site} );
139	dpavlin	153	my $log = $c->log;
140
141	dpavlin	400	$log->dumper($params, 'params');
142	dpavlin	153
143	dpavlin	200	if (! $params->{_page} \|\| $params->{_page} < 1) {
144	dpavlin	161	$params->{_page} = 1;
145			$log->warn("fixed _page parametar to 1");
146			}
147
148	dpavlin	153	my @words;
149			# default operator to join fields/words
150			my $operator = 'AND';
151
152			foreach my $f (keys %{ $params }) {
153
154			next if ($f =~ m/^_/o);
155
156			my $v = $params->{$f} \|\| next;
157
158			if (my $op = $params->{ '_' . $f}) {
159	dpavlin	313	if ($v =~ /$hest_op_regex/) {
160	dpavlin	153	# don't split words if there is Hyper Estraier
161			# operator in them
162			push @words, $v;
163			} else {
164			push @words, join(" $op ", split(/\s+/, $v) );
165			}
166			} else {
167			push @words, $v;
168			}
169
170			next if ($f eq 'all'); # don't add_attr for magic field all
171
172			if ($v !~ /\s/) {
173	dpavlin	326	push @{ $c->stash->{attr} }, "$f ISTRINC $v";
174	dpavlin	153	} else {
175			map {
176	dpavlin	326	push @{ $c->stash->{attr} }, "$f ISTRINC $_";
177	dpavlin	313	} grep { ! /$hest_op_regex/ } split(/\s+/, $v);
178	dpavlin	153	}
179			}
180
181	dpavlin	326	$c->forward('filter_database');
182	dpavlin	275
183	dpavlin	153	my $q = join(" $operator ", @words);
184
185	dpavlin	155	my $template = $params->{'_template'} \|\| $c->config->{webpac}->{template};
186
187			$log->die("can't find _template or default from configuration!") unless ($template);
188
189	dpavlin	160	my $hits_on_page = $c->config->{'hyperestraier'}->{'hits_on_page'} \|\| 10;
190	dpavlin	153
191	dpavlin	160	$log->debug("using template $template to produce $hits_on_page results");
192
193	dpavlin	405	$c->stash->{html_results} = $webpac->search(
194	dpavlin	153	phrase => $q,
195			template => $template,
196	dpavlin	326	add_attr => $c->{stash}->{attr},
197	dpavlin	155	get_attr => [ '@uri' ],
198	dpavlin	160	max => $hits_on_page,
199	dpavlin	159	page => $params->{'_page'},
200	dpavlin	405	);
201	dpavlin	153
202	dpavlin	405	$c->stash->{hints} = $webpac->hints;
203
204	dpavlin	153	$c->stash->{phrase} = $q;
205	dpavlin	440	$c->stash->{page} = $params->{_page};
206	dpavlin	160	$c->stash->{hits_on_page} = $hits_on_page;
207	dpavlin	153
208	dpavlin	440	# create pager
209			$c->stash->{pager} = new Data::SpreadPagination({
210			totalEntries => $webpac->hints->{hit},
211			entriesPerPage => $hits_on_page,
212			currentPage => $params->{_page},
213			maxPages => $c->config->{pager}->{max_pages} \|\| 10,
214			});
215
216	dpavlin	442	my $site_uri_params = $params;
217	dpavlin	441
218	dpavlin	442	map {
219			delete( $site_uri_params->{$_} ) unless ( $site_uri_params->{$_} );
220			} keys %{ $site_uri_params };
221
222			$c->stash->{site_uri_params} = sub {
223
224			my $s_params = $site_uri_params;
225
226			$c->log->dumper( $s_params, 'original_params' );
227
228			my $n_params = shift;
229			foreach my $p (keys %{ $n_params }) {
230			if (! $n_params->{$p}) {
231			delete($s_params->{$p});
232			} else {
233			$s_params->{$p} = $n_params->{$p};
234			}
235			}
236
237			$c->log->dumper( $s_params, 'site_uri_params' );
238			return $c->uri_for('results', $s_params)->as_string;
239			};
240
241	dpavlin	153	$c->stash->{template} = 'results.tt';
242	dpavlin	270
243	dpavlin	153	}
244
245	dpavlin	326	=item filter_database
246
247			Takes C<< $c->req->params >> and adds Hyper Estraier
248			filters for checked databases to C<< $c->stash->{attr} >>.
249
250			=cut
251
252			sub filter_database : Private {
253			my ( $self, $c ) = @_;
254
255			my $params = $c->req->params;
256
257			if ($params->{_database}) {
258			my $type = $c->config->{hyperstraier}->{type} \|\| 'search';
259			my $attr;
260			if (ref($params->{_database}) eq 'ARRAY') {
261			# FIXME do we need to add $ at end?
262			$attr .= '(' . join("\|",@{$params->{_database}}) . ')';
263			} else {
264			$attr .= $params->{_database};
265			}
266			push @{ $c->stash->{attr} }, '@uri STRRX /' . $type . '/' . $attr . '/';
267			$c->log->debug("filter_database: " . join(",", @{ $c->stash->{attr} }) );
268			}
269
270
271			}
272
273	dpavlin	187	=item record
274
275			forwarded to C</editor/record>
276
277			=cut
278
279			sub record : Local {
280			my ( $self, $c ) = @_;
281
282	dpavlin	407	$c->detach( '/editor/record' );
283	dpavlin	187	}
284
285	dpavlin	109	=back
286
287			=head1 AUTHOR
288
289	dpavlin	153	Dobrica Pavlinusic C<< <dpavlin@rot13.org> >>
290	dpavlin	109
291			=head1 LICENSE
292
293			This library is free software, you can redistribute it and/or modify
294			it under the same terms as Perl itself.
295
296			=cut
297
298			1;