1 package WebPAC::Search::Estraier;
7 use Encode qw/from_to/;
8 use Data::Dump qw/dump/;
12 WebPAC::Search::Estraier - search Hyper Estraier full text index
20 our $VERSION = '0.07';
24 Search WebPAC data using Hyper Estraier full text index created with
25 L<WebPAC::Output::Estraier>.
31 Connect to Hyper Estraier index using HTTP
33 my $est = new WebPAC::Search::Estraier(
34 masterurl => 'http://localhost:1978/',
35 database => 'webpac2',
38 encoding => 'iso-8859-2',
39 log => $Log::Log4perl->log_object,
48 URI to C<estmaster> node
52 name of C<estmaster> node
56 C<estmaster> user with read rights
64 character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
65 (and it probably is). This encoding will be converted to C<UTF-8> for
70 L<Log::Log4perl> object or equivalent (C<< $c->log >> can be used in
71 L<Catalyst> and there is support for it).
82 my $log = $self->_get_logger;
84 foreach my $p (qw/masterurl user passwd/) {
85 $log->logdie("need $p") unless ($self->{$p});
88 my $url = $self->{masterurl} . '/node/' . $self->{database};
91 $log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");
93 $self->{db} = Search::Estraier::Node->new;
94 $self->{db}->set_url($self->{'url'});
95 $self->{db}->set_auth($self->{'user'}, $self->{'passwd'});
97 $self->{'encoding'} ||= 'ISO-8859-2';
98 $log->info("using encoding ",$self->{encoding});
100 $self ? return $self : return undef;
106 Locate items in index
108 my @results = $est->search(
109 phrase => 'name of book or novel',
111 "filepath ISTRINC $q",
114 get_attr => qw/PersonalName TitleProper/,
117 options => $HyperEstraier::Condition::SURE,
122 Options are close match to Hyper Estraier API, except C<get_attr> which defines
123 attributes which will be returned in hash for each record.
125 Results are returned as hash array with keys named by attributes
127 Pages are numbered C< 1 ... hits/max >.
136 my $log = $self->_get_logger;
138 #$log->debug( 'search args: ', dump($args) );
140 $self->confess('need db in object') unless ($self->{db});
141 $self->confess('need get_attr') unless ($args->{get_attr});
143 $self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');
145 my $q = $args->{phrase};
147 $log->debug("args: ", dump( $args ));
149 my $cond = Search::Estraier::Condition->new();
150 if ( ref($args->{add_attr}) eq 'ARRAY' ) {
151 $log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
153 $cond->add_attr( $self->convert( $_ ) );
154 $log->debug(" + $_");
155 } @{ $args->{add_attr} };
158 $cond->set_phrase( $self->convert($q) ) if ($q);
159 $cond->set_options( $args->{options} ) if ($args->{options});
160 $cond->set_order( $args->{order} ) if ($args->{order});
162 my $max = $args->{max} || 7;
163 my $page = $args->{page} || 1;
165 $log->warn("page number $page < 1");
169 $cond->set_max( $page * $max );
171 my $result = $self->{db}->search($cond, ( $args->{depth} || 0 )) ||
172 $log->logdie("can't search for ", sub { dump( $args ) });
174 my $hits = $result->doc_num;
175 $log->debug("found $hits hits for '$q'");
179 for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {
181 #$log->debug("get_doc($i)");
182 my $doc = $result->get_doc( $i );
184 $log->warn("can't find result $i");
190 foreach my $attr (@{ $args->{get_attr} }) {
191 my $val = $doc->attr( $attr );
192 #$log->debug("attr $attr = ", $val || 'undef');
193 $hash->{$attr} = $self->convert( $val ) if (defined($val));
197 push @results, $hash;
202 # $log->debug("results " . dump( \@results ));
204 $self->confess("expected to return array") unless (wantarray);
211 wrapper around L<Log::Log4perl> C<confess> or C<< $log->fatal >> or
212 C<< $log->error >> if they exists (like in L<Catalyst>), else plain
219 if (my $log = $self->{'log'}) {
220 if ($log->can('logconfess')) {
221 $log->logconfess(@_);
222 } elsif ($log->can('fatal')) {
225 } elsif ($log->can('error')) {
237 convert internal encoding to UTF-8
239 my $utf8 = $self->convert( $text );
246 my $text = shift || return;
248 from_to($text, $self->{encoding}, 'UTF-8');
255 For compatibility with same method from L<WebPAC::Common>, but without
263 return $self->{'log'} || die "really need log!";
268 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
270 =head1 COPYRIGHT & LICENSE
272 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
274 This program is free software; you can redistribute it and/or modify it
275 under the same terms as Perl itself.
279 1; # End of WebPAC::Search::Estraier