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;


=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} = sub {
                my $res = $webpac->search( 
                        phrase => $q,
                        template => $template,
                        add_attr => $c->{stash}->{attr},
                        get_attr => [ '@uri' ],
                        max => $hits_on_page,
                        page => $params->{'_page'},
                );
#               $log->debug("controller got " . ( $#{$res} + 1 ) . " results for '$q' " . Dumper( $res ));
                return $res;
        };

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

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