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 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' );

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

        my $index_path = Webpacus::Webpac->index_path;

        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 = 1;

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

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