Webpacus/Controller/Results.pm

package Webpacus::Controller::Results;

use strict;
use warnings;
use base qw/Catalyst::Controller/;
use Data::Dumper;

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

=head1 NAME

Webpacus::Controller::Results - Display results from WebPAC

=head1 SYNOPSIS

See L<Webpacus>

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=over 4

=item default

=cut

sub default : Private {
        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( $q, $template, \@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,,,

=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	83	package Webpacus::Controller::Results;
2
3			use strict;
4			use warnings;
5	dpavlin	97	use base qw/Catalyst::Controller/;
6	dpavlin	133	use Data::Dumper;
7	dpavlin	83
8	dpavlin	149	# specify all Hyper Estraier operators which should stop this module
9			# from splitting search query and joining it with default operator
10			my $hest_op_regex = qr/(:?\[(:?BW\|EW\|RX)\]\|AND\|OR\|ANDNOT)/;
11	dpavlin	147
12	dpavlin	83	=head1 NAME
13
14	dpavlin	97	Webpacus::Controller::Results - Display results from WebPAC
15	dpavlin	83
16			=head1 SYNOPSIS
17
18			See L<Webpacus>
19
20			=head1 DESCRIPTION
21
22			Catalyst Controller.
23
24			=head1 METHODS
25
26			=over 4
27
28			=item default
29
30			=cut
31
32			sub default : Private {
33	dpavlin	147	my ( $self, $c ) = @_;
34	dpavlin	83
35	dpavlin	147	my $webpac = $c->comp('Model::WebPAC');
36			my $params = $c->req->params;
37			my $log = $c->log;
38	dpavlin	83
39	dpavlin	147	$log->debug("results got params: " . Dumper( $params ) );
40	dpavlin	93
41	dpavlin	147	my @attr;
42			my @words;
43			# default operator to join fields/words
44			my $operator = 'AND';
45	dpavlin	94
46	dpavlin	147	foreach my $f (keys %{ $params }) {
47	dpavlin	98
48	dpavlin	147	next if ($f =~ m/^_/o);
49	dpavlin	98
50	dpavlin	147	my $v = $params->{$f} \|\| next;
51	dpavlin	98
52	dpavlin	147	if (my $op = $params->{ '_' . $f}) {
53			if ($v =~ $hest_op_regex) {
54			# don't split words if there is Hyper Estraier
55			# operator in them
56			push @words, $v;
57			} else {
58			push @words, join(" $op ", split(/\s+/, $v) );
59			}
60			} else {
61			push @words, $v;
62			}
63	dpavlin	118
64	dpavlin	147	next if ($f eq 'all'); # don't add_attr for magic field all
65	dpavlin	118
66	dpavlin	147	if ($v !~ /\s/) {
67			push @attr, "$f ISTRINC $v";
68			} else {
69			map {
70			push @attr, "$f ISTRINC $_";
71			} grep { ! $hest_op_regex } split(/\s+/, $v);
72			}
73	dpavlin	118	}
74	dpavlin	94
75	dpavlin	133	my $q = join(" $operator ", @words);
76	dpavlin	129
77	dpavlin	139	my $template = $params->{'_template'};
78			$log->debug("using template $template");
79
80	dpavlin	147	$c->stash->{html_results} = sub {
81			my $res = $webpac->search( $q, $template, \@attr );
82			# $log->debug("controller got " . ( $#{$res} + 1 ) . " results for '$q' " . Dumper( $res ));
83			return $res;
84			};
85	dpavlin	93
86	dpavlin	147	$c->stash->{phrase} = $q;
87			$c->stash->{attr} = \@attr;
88	dpavlin	129
89	dpavlin	147	$c->stash->{template} = 'results.tt';
90	dpavlin	83	}
91
92			=back
93
94
95			=head1 AUTHOR
96
97			Dobrica Pavlinusic,,,
98
99			=head1 LICENSE
100
101			This library is free software, you can redistribute it and/or modify
102			it under the same terms as Perl itself.
103
104			=cut
105
106			1;