Webpacus/Controller/Results.pm

package Webpacus::Controller::Results;

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

my $hest_op_regex = qr/\[(:?BW|EW|RX)\]/;

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