Webpacus/Action/Search.pm

use strict;
use warnings;

=head1 NAME

Webpacus::Action::Search

=cut

package Webpacus::Action::Search;
use base qw/Webpacus::Action Jifty::Action/;

use Data::Dump qw/dump/;
# enables start witout this file which is created by WebPAC later
eval { require Webpacus::Webpac };
use KinoSearch::Simple;

use Jifty::Param::Schema;
use Jifty::Action schema {

param field =>
        label is _("Field name"),
        available are defer {
                my $coll = Webpacus::Model::SearchCollection->new;
                $coll->unlimit;
                [ '', {  
                        display_from => 'name',
                        value_from => 'id',
                        collection => $coll,
                }];
        },
        render as 'Select';

param database =>
        label is _("From database"),
        available are defer {
                my $coll = Webpacus::Model::SearchCollection->new;
                $coll->group_by( column => 'from_database' );
                $coll->unlimit;
                [{  
                        display_from => 'from_database',
                        value_from => 'from_database',
                        collection => $coll,
                }];
        },
        render as 'Select';

param query =>
        label is _("Search for"),
        is mandatory;
        

};

sub sticky_on_success { 1 }
sub sticky_on_failure { 1 }

=head2 take_action

Create C<results> which can be accessed from L<Template::Declare> like this:

  my $results = $search->result->content('results');

=cut

sub take_action {
        my $self = shift;

        my $search = Webpacus::Model::Search->load( $self->argument_value( 'field' ) );
        my $query = $self->argument_value( 'query' );
        my $database = $self->argument_value( 'database' );

        warn "## search = ",dump( $search );

        my $index_path = Webpacus::Webpac->index_path;
        $index_path .= '/' . $database;

        warn "## index_path = $index_path";

        my $index = KinoSearch::Simple->new(
                path => $index_path,
                language => 'en',
        );

        my $total_hits = $index->search(
                query      => $query,
                offset     => 0,
                num_wanted => 100,
        );

        my $message =
                _('Found') . " $total_hits " .
                _('results for') . " '$query'";
        
        $message .= " " . _('on field') . ' ' . $search->name if $search;

        $self->result->content(
                results => Webpacus::Search::Results->new({
                        count => $total_hits,
                        index => $index,
                }),
        );

        $self->result->message( $message );
    
        return 1;
}

package Webpacus::Search::Results;

use strict;
use warnings;
use base qw( Class::Accessor );
__PACKAGE__->mk_accessors( qw(
        count
        index
) );

use lib '/data/webpac2/lib';
use WebPAC::Store;

use Data::Dump qw/dump/;

my $debug = 0;

my $store;

=head2 count

Returns number of records in results

  my $nr_records = $results->count;

=head2 next

Fetch next result and return C<Webpacus::Search::DS> object

  while ( my $ds = $results->next ) {
                # do something with $ds object
  }

=cut

sub next {
        my $self = shift;

        if ( ! $store ) {
                $store = WebPAC::Store->new({
                        debug => $debug,
                });
                warn "## create WebPAC::Store\n";
        }

        my $hit = $self->index->fetch_hit_hashref;

        return unless $hit;

        warn "## next hit = ", dump( $hit ) if $debug;

        my $ds = $store->load_ds(
                database => $hit->{database},
                input    => $hit->{input},
                id       => $hit->{id},
        );

        if ( ! $ds ) {
                warn "can't find ds for hit ", dump( $hit ), $/ unless $ds;
                return;
        }

        # add permanent fields
        $ds->{$_} ||= { display => $hit->{$_} } foreach ( qw/
                database input id
                score
        / );

        return Webpacus::Action::DS->new( $ds );

}

package Webpacus::Action::DS;

use warnings;
use strict;

use Data::Dump qw/dump/;
use Carp qw/confess/;

sub new {
        my $class = shift;

        my ( $ds ) = @_;

        my $self = {
                ds => $ds,
        };
        bless ($self, $class);

        return $self;

}

sub _row {
        my ( $self, $type, $field, $delimiter ) = @_;

        confess "no type?" unless $type;
        confess "no field?" unless $field;
        confess "no ds?" unless $self->{ds};

        $delimiter ||= '[x]';

        my $ds = $self->{ds};

        warn "### ds = ",dump( $ds ) if $debug;

        return unless defined $ds->{$field}->{$type};

        if ( my $v = $ds->{$field}->{$type} ) {

                if ( ref($v) eq 'ARRAY' ) {
                        warn "is array ", wantarray ? 'wantarray' : 'scalar', " $field $type" if $debug;
                        return @$v if wantarray;
                        return join( $delimiter, @$v );
                } else {
                        warn "not array ", wantarray ? 'wantarray' : 'scalar', " $field $type" if $debug;
                        return $v;
                }

        } else {
                return;
        }

}

=head2 display

  $ds->display( 'TitleProper' );

=cut

sub display {
        my $self = shift;
        warn "## display(",dump(@_),")\n";
        return $self->_row('display',@_);
}

1;

1	dpavlin	930	use strict;
2			use warnings;
3
4			=head1 NAME
5
6			Webpacus::Action::Search
7
8			=cut
9
10			package Webpacus::Action::Search;
11			use base qw/Webpacus::Action Jifty::Action/;
12
13			use Data::Dump qw/dump/;
14	dpavlin	945	# enables start witout this file which is created by WebPAC later
15			eval { require Webpacus::Webpac };
16	dpavlin	934	use KinoSearch::Simple;
17	dpavlin	930
18			use Jifty::Param::Schema;
19			use Jifty::Action schema {
20
21	dpavlin	931	param field =>
22	dpavlin	930	label is _("Field name"),
23			available are defer {
24			my $coll = Webpacus::Model::SearchCollection->new;
25			$coll->unlimit;
26			[ '', {
27			display_from => 'name',
28			value_from => 'id',
29			collection => $coll,
30			}];
31			},
32			render as 'Select';
33
34	dpavlin	999	param database =>
35			label is _("From database"),
36			available are defer {
37			my $coll = Webpacus::Model::SearchCollection->new;
38			$coll->group_by( column => 'from_database' );
39			$coll->unlimit;
40			[{
41			display_from => 'from_database',
42			value_from => 'from_database',
43			collection => $coll,
44			}];
45			},
46			render as 'Select';
47
48	dpavlin	931	param query =>
49	dpavlin	930	label is _("Search for"),
50			is mandatory;
51
52
53			};
54
55			sub sticky_on_success { 1 }
56			sub sticky_on_failure { 1 }
57
58			=head2 take_action
59
60	dpavlin	963	Create C<results> which can be accessed from L<Template::Declare> like this:
61
62			my $results = $search->result->content('results');
63
64	dpavlin	930	=cut
65
66			sub take_action {
67			my $self = shift;
68
69	dpavlin	931	my $search = Webpacus::Model::Search->load( $self->argument_value( 'field' ) );
70	dpavlin	934	my $query = $self->argument_value( 'query' );
71	dpavlin	999	my $database = $self->argument_value( 'database' );
72	dpavlin	930
73			warn "## search = ",dump( $search );
74
75	dpavlin	934	my $index_path = Webpacus::Webpac->index_path;
76	dpavlin	999	$index_path .= '/' . $database;
77	dpavlin	934
78			warn "## index_path = $index_path";
79
80			my $index = KinoSearch::Simple->new(
81			path => $index_path,
82			language => 'en',
83			);
84
85			my $total_hits = $index->search(
86			query => $query,
87			offset => 0,
88			num_wanted => 100,
89			);
90
91	dpavlin	931	my $message =
92	dpavlin	934	_('Found') . " $total_hits " .
93	dpavlin	940	_('results for') . " '$query'";
94
95	dpavlin	954	$message .= " " . _('on field') . ' ' . $search->name if $search;
96	dpavlin	930
97	dpavlin	935	$self->result->content(
98			results => Webpacus::Search::Results->new({
99			count => $total_hits,
100			index => $index,
101			}),
102			);
103	dpavlin	934
104	dpavlin	930	$self->result->message( $message );
105
106			return 1;
107			}
108
109	dpavlin	935	package Webpacus::Search::Results;
110
111			use strict;
112			use warnings;
113			use base qw( Class::Accessor );
114			__PACKAGE__->mk_accessors( qw(
115			count
116			index
117			) );
118
119	dpavlin	943	use lib '/data/webpac2/lib';
120			use WebPAC::Store;
121
122	dpavlin	935	use Data::Dump qw/dump/;
123
124	dpavlin	1081	my $debug = 0;
125	dpavlin	943
126			my $store;
127
128	dpavlin	963	=head2 count
129
130			Returns number of records in results
131
132			my $nr_records = $results->count;
133
134			=head2 next
135
136			Fetch next result and return C<Webpacus::Search::DS> object
137
138			while ( my $ds = $results->next ) {
139			# do something with $ds object
140			}
141
142			=cut
143
144	dpavlin	935	sub next {
145			my $self = shift;
146
147	dpavlin	943	if ( ! $store ) {
148			$store = WebPAC::Store->new({
149			debug => $debug,
150			});
151			warn "## create WebPAC::Store\n";
152			}
153	dpavlin	935
154	dpavlin	943	my $hit = $self->index->fetch_hit_hashref;
155
156			return unless $hit;
157
158			warn "## next hit = ", dump( $hit ) if $debug;
159
160			my $ds = $store->load_ds(
161			database => $hit->{database},
162			input => $hit->{input},
163			id => $hit->{id},
164			);
165
166			if ( ! $ds ) {
167			warn "can't find ds for hit ", dump( $hit ), $/ unless $ds;
168			return;
169			}
170
171	dpavlin	963	# add permanent fields
172	dpavlin	1081	$ds->{$_} \|\|= { display => $hit->{$_} } foreach ( qw/
173			database input id
174			score
175			/ );
176	dpavlin	943
177	dpavlin	963	return Webpacus::Action::DS->new( $ds );
178	dpavlin	943
179	dpavlin	963	}
180	dpavlin	943
181	dpavlin	963	package Webpacus::Action::DS;
182	dpavlin	943
183	dpavlin	963	use warnings;
184			use strict;
185	dpavlin	943
186	dpavlin	963	use Data::Dump qw/dump/;
187			use Carp qw/confess/;
188
189			sub new {
190			my $class = shift;
191
192			my ( $ds ) = @_;
193
194	dpavlin	1081	my $self = {
195	dpavlin	963	ds => $ds,
196			};
197			bless ($self, $class);
198
199			return $self;
200
201			}
202
203			sub _row {
204			my ( $self, $type, $field, $delimiter ) = @_;
205
206			confess "no type?" unless $type;
207			confess "no field?" unless $field;
208			confess "no ds?" unless $self->{ds};
209
210			$delimiter \|\|= '[x]';
211
212			my $ds = $self->{ds};
213
214			warn "### ds = ",dump( $ds ) if $debug;
215
216			return unless defined $ds->{$field}->{$type};
217
218			if ( my $v = $ds->{$field}->{$type} ) {
219
220			if ( ref($v) eq 'ARRAY' ) {
221			warn "is array ", wantarray ? 'wantarray' : 'scalar', " $field $type" if $debug;
222			return @$v if wantarray;
223			return join( $delimiter, @$v );
224			} else {
225			warn "not array ", wantarray ? 'wantarray' : 'scalar', " $field $type" if $debug;
226			return $v;
227	dpavlin	954	}
228	dpavlin	963
229			} else {
230	dpavlin	954	return;
231			}
232	dpavlin	963
233	dpavlin	935	}
234
235	dpavlin	963	=head2 display
236
237			$ds->display( 'TitleProper' );
238
239			=cut
240
241			sub display {
242			my $self = shift;
243			warn "## display(",dump(@_),")\n";
244			return $self->_row('display',@_);
245			}
246
247	dpavlin	930	1;
248