Webpacus/Controller/Search.pm

package Webpacus::Controller::Search;

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

use Data::Dumper;

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->debug("default search got param: ".Dumper($c->req->params));

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

=item suggest

Returns results for URLs like C<search/suggest/FieldName>

It will return field from URL (C<FieldName> in example>) and use
same filed in paramerers (comming from form or URL) or if it doesn't
exist field named C<all>.

=cut

sub suggest : Regex('^search/suggest/*([^/]*)') {
        my ( $self, $c ) = @_;

        my $what = $c->request->snippets->[0];

        my $log = $c->log;

        my $webpac = $c->comp('Model::WebPAC');

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


        $log->info("search for '$q' in $what\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;
        }

        my @hits = $webpac->search(
                phrase => $q,
                max => $max,
                get_attr => [ $what ],
        );

        my $used;
        my @suggestions;

        foreach my $res (@hits) {
                my $v = $res->{ $what } || 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;

        # oh, client didn't have ability to setup AJAX, fallback to
        # page refresh
        if (! $params->{'_ajax'}) {
                $params->{_ajax} = 1;
                $c->stash->{results} = $c->subreq('/search/results/ajax', {}, $params);
        $c->stash->{template} = 'search.tt';
        } else {
                $c->forward('/search/results/ajax');
        $c->stash->{template} = 'results.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 = qr/(:?\[(:?BW|EW|RX)\]|AND|OR|ANDNOT)/o;

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

        my $params = $c->req->params;
        my $webpac = $c->comp('Model::WebPAC');
        my $log = $c->log;

        $log->debug("results got params: " . Dumper( $params ) );

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

        my @attr;
        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 @attr, "$f ISTRINC $v";
                } else {
                        map {
                                push @attr, "$f ISTRINC $_";
                        } grep { ! $hest_op_regex } split(/\s+/, $v);
                }
        }

        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 => \@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->{attr} = \@attr;
        $c->stash->{page} = $params->{'_page'};
        $c->stash->{hits_on_page} = $hits_on_page;

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

}

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