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;


=head1 NAME

Webpacus::Controller::Search - Catalyst Controller

=head1 SYNOPSIS

See L<Webpacus>

=head1 DESCRIPTION

Catalyst Controller for autocompleting search fields.

=head1 METHODS

=over 4

=item default

=cut

sub default : Private {
    my ( $self, $c ) = @_;
    $c->stash->{template} = 'search.tt';
}

=item suggest

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

=cut

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

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

        my $log = $c->log;

        my $est_conf = $c->config->{hyperestraier};
        $est_conf->{log} = $c->log;

        my $est = new WebPAC::Search::Estraier( %{ $est_conf } );

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


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

        my $max = $est_conf->{'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 = $est->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->res->body( $c->prototype->auto_complete_result( \@suggestions ) );
}


# 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)/;

=item results

Mothod which uses C<Model::WebPAC> and returns results for search query

=cut

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

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

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

        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'};
        $log->debug("using template $template");

        $c->stash->{html_results} = sub {
                my $res = $webpac->search( 
                        phrase => $q,
                        template => $template,
                        add_attr => \@attr
                );
        #       $log->debug("controller got " . ( $#{$res} + 1 ) . " results for '$q' " . Dumper( $res ));
                return $res;
        };

        $c->stash->{phrase} = $q;
        $c->stash->{attr} = \@attr;

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

=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			use WebPAC::Search::Estraier;
11
12	dpavlin	153
13	dpavlin	109	=head1 NAME
14
15			Webpacus::Controller::Search - Catalyst Controller
16
17			=head1 SYNOPSIS
18
19			See L<Webpacus>
20
21			=head1 DESCRIPTION
22
23			Catalyst Controller for autocompleting search fields.
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			$c->stash->{template} = 'search.tt';
36			}
37
38			=item suggest
39
40			Returns results for URLs like C<search/suggest/FieldName>
41
42			=cut
43
44			sub suggest : Regex('^search/suggest/([^/])') {
45	dpavlin	143	my ( $self, $c ) = @_;
46	dpavlin	109
47	dpavlin	143	my $what = $c->request->snippets->[0];
48	dpavlin	109
49	dpavlin	143	my $log = $c->log;
50	dpavlin	109
51	dpavlin	143	my $est_conf = $c->config->{hyperestraier};
52			$est_conf->{log} = $c->log;
53	dpavlin	109
54	dpavlin	143	my $est = new WebPAC::Search::Estraier( %{ $est_conf } );
55	dpavlin	117
56	dpavlin	143	my $q = $c->req->params->{$what} \|\|
57			$c->req->params->{all} \|\| $c->res->output("no results");
58	dpavlin	109
59	dpavlin	143
60	dpavlin	109	$log->info("search for '$q' in $what\n");
61
62	dpavlin	143	my $max = $est_conf->{'hits_for_suggest'};
63			if (! $max) {
64			$log->info("hits_for_suggest isn't defined, defaulting to 10");
65			$c->config->{'hits_for_suggest'} = 10;
66			$max = 10;
67			}
68	dpavlin	109
69	dpavlin	143	my @hits = $est->search( phrase => $q, max => $max, get_attr => [ $what ] );
70	dpavlin	109
71	dpavlin	143	my $used;
72			my @suggestions;
73
74			foreach my $res (@hits) {
75			my $v = $res->{ $what } \|\| next;
76			next if ($used->{ $v }++);
77			push @suggestions, $v;
78			}
79
80			$log->debug( ($#suggestions + 1) . " unique hits returned");
81
82			$c->res->body( $c->prototype->auto_complete_result( \@suggestions ) );
83	dpavlin	109	}
84
85	dpavlin	153
86			# specify all Hyper Estraier operators which should stop this module
87			# from splitting search query and joining it with default operator
88			my $hest_op_regex = qr/(:?\[(:?BW\|EW\|RX)\]\|AND\|OR\|ANDNOT)/;
89
90			=item results
91
92			Mothod which uses C<Model::WebPAC> and returns results for search query
93
94			=cut
95
96			sub results : Local {
97			my ( $self, $c ) = @_;
98
99			my $webpac = $c->comp('Model::WebPAC');
100			my $params = $c->req->params;
101			my $log = $c->log;
102
103			$log->debug("results got params: " . Dumper( $params ) );
104
105			my @attr;
106			my @words;
107			# default operator to join fields/words
108			my $operator = 'AND';
109
110			foreach my $f (keys %{ $params }) {
111
112			next if ($f =~ m/^_/o);
113
114			my $v = $params->{$f} \|\| next;
115
116			if (my $op = $params->{ '_' . $f}) {
117			if ($v =~ $hest_op_regex) {
118			# don't split words if there is Hyper Estraier
119			# operator in them
120			push @words, $v;
121			} else {
122			push @words, join(" $op ", split(/\s+/, $v) );
123			}
124			} else {
125			push @words, $v;
126			}
127
128			next if ($f eq 'all'); # don't add_attr for magic field all
129
130			if ($v !~ /\s/) {
131			push @attr, "$f ISTRINC $v";
132			} else {
133			map {
134			push @attr, "$f ISTRINC $_";
135			} grep { ! $hest_op_regex } split(/\s+/, $v);
136			}
137			}
138
139			my $q = join(" $operator ", @words);
140
141			my $template = $params->{'_template'};
142			$log->debug("using template $template");
143
144			$c->stash->{html_results} = sub {
145			my $res = $webpac->search(
146			phrase => $q,
147			template => $template,
148			add_attr => \@attr
149			);
150			# $log->debug("controller got " . ( $#{$res} + 1 ) . " results for '$q' " . Dumper( $res ));
151			return $res;
152			};
153
154			$c->stash->{phrase} = $q;
155			$c->stash->{attr} = \@attr;
156
157			$c->stash->{template} = 'results.tt';
158			}
159
160	dpavlin	109	=back
161
162
163			=head1 AUTHOR
164
165	dpavlin	153	Dobrica Pavlinusic C<< <dpavlin@rot13.org> >>
166	dpavlin	109
167			=head1 LICENSE
168
169			This library is free software, you can redistribute it and/or modify
170			it under the same terms as Perl itself.
171
172			=cut
173
174			1;