/[webpac2]/Webpacus2/lib/Webpacus/Action/Search.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Webpacus2/lib/Webpacus/Action/Search.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 931 by dpavlin, Wed Oct 31 10:35:07 2007 UTC revision 1092 by dpavlin, Tue Feb 12 19:12:48 2008 UTC
# Line 11  package Webpacus::Action::Search; Line 11  package Webpacus::Action::Search;
11  use base qw/Webpacus::Action Jifty::Action/;  use base qw/Webpacus::Action Jifty::Action/;
12    
13  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
14    # enables start witout this file which is created by WebPAC later
15    eval { require Webpacus::Webpac };
16    use KinoSearch::Simple;
17    
18  use Jifty::Param::Schema;  use Jifty::Param::Schema;
19  use Jifty::Action schema {  use Jifty::Action schema {
# Line 28  param field => Line 31  param field =>
31          },          },
32          render as 'Select';          render as 'Select';
33    
34    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  param query =>  param query =>
49          label is _("Search for"),          label is _("Search for"),
50          is mandatory;          is mandatory;
# Line 40  sub sticky_on_failure { 1 } Line 57  sub sticky_on_failure { 1 }
57    
58  =head2 take_action  =head2 take_action
59    
60    Create C<results> which can be accessed from L<Template::Declare> like this:
61    
62      my $results = $search->result->content('results');
63    
64  =cut  =cut
65    
66  sub take_action {  sub take_action {
67          my $self = shift;          my $self = shift;
68    
69          my $search = Webpacus::Model::Search->load( $self->argument_value( 'field' ) );          my $search = Webpacus::Model::Search->load( $self->argument_value( 'field' ) );
70            my $query = $self->argument_value( 'query' );
71            my $database = $self->argument_value( 'database' );
72    
73          warn "## search = ",dump( $search );          warn "## search = ",dump( $search );
74    
75            my $index_path = Webpacus::Webpac->index_path;
76            $index_path .= '/' . $database;
77    
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          my $message =          my $message =
92                  _('Results for') . " '" . $self->argument_value( 'query' ) . "' " .                  _('Found') . " $total_hits " .
93                  _('on field') . ' ' . $search->name;                  _('results for') . " '$query'";
94            
95            $message .= " " . _('on field') . ' ' . $search->name if $search;
96    
97            $self->result->content(
98                    results => Webpacus::Search::Results->new({
99                            count => $total_hits,
100                            index => $index,
101                    }),
102            );
103    
104          $self->result->message( $message );          $self->result->message( $message );
105            
106          return 1;          return 1;
107  }  }
108    
109    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    use lib '/data/webpac2/lib';
120    use WebPAC::Store;
121    
122    use Data::Dump qw/dump/;
123    
124    my $debug = 0;
125    
126    my $store;
127    
128    =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    sub next {
145            my $self = shift;
146    
147            if ( ! $store ) {
148                    $store = WebPAC::Store->new({
149                            debug => $debug,
150                    });
151                    warn "## create WebPAC::Store\n";
152            }
153    
154            my $hit = $self->index->fetch_hit;
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            # add permanent fields
172            $ds->{$_} ||= { display => $hit->{$_} } foreach ( qw/
173                    database input id
174                    score
175            / );
176    
177            return Webpacus::Action::DS->new( $ds );
178    
179    }
180    
181    package Webpacus::Action::DS;
182    
183    use warnings;
184    use strict;
185    
186    use Data::Dump qw/dump/;
187    use Carp qw/confess/;
188    
189    sub new {
190            my $class = shift;
191    
192            my ( $ds ) = @_;
193    
194            my $self = {
195                    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                    }
228    
229            } else {
230                    return;
231            }
232    
233    }
234    
235    =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  1;  1;
248    
Legend:
Removed from v.931  
changed lines
  Added in v.1092
  ViewVC Help
Powered by ViewVC 1.1.26