/[webpac2]/trunk/lib/WebPAC/Search/Estraier.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 /trunk/lib/WebPAC/Search/Estraier.pm

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

revision 86 by dpavlin, Tue Nov 22 08:37:40 2005 UTC revision 535 by dpavlin, Mon Jun 26 16:39:42 2006 UTC
# Line 3  package WebPAC::Search::Estraier; Line 3  package WebPAC::Search::Estraier;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use HyperEstraier;  use Search::Estraier;
7  use Text::Iconv;  use Encode qw/from_to/;
8  use Data::Dumper;  use Data::Dumper;
9    
10  =head1 NAME  =head1 NAME
# Line 13  WebPAC::Search::Estraier - search Hyper Line 13  WebPAC::Search::Estraier - search Hyper
13    
14  =head1 VERSION  =head1 VERSION
15    
16  Version 0.01  Version 0.07
17    
18  =cut  =cut
19    
20  our $VERSION = '0.01';  our $VERSION = '0.07';
21    
22  =head1 SYNOPSIS  =head1 SYNOPSIS
23    
# Line 31  L<WebPAC::Output::Estraier>. Line 31  L<WebPAC::Output::Estraier>.
31  Connect to Hyper Estraier index using HTTP  Connect to Hyper Estraier index using HTTP
32    
33   my $est = new WebPAC::Search::Estraier(   my $est = new WebPAC::Search::Estraier(
34          url => 'http://localhost:1978/node/webpac2',          masterurl => 'http://localhost:1978/',
35            database => 'webpac2',
36          user => 'admin',          user => 'admin',
37          passwd => 'admin',          passwd => 'admin',
38          encoding => 'iso-8859-2',          encoding => 'iso-8859-2',
# Line 42  Options are: Line 43  Options are:
43    
44  =over 4  =over 4
45    
46  =item url  =item maseterurl
47    
48  URI to C<estmaster> node  URI to C<estmaster> node
49    
50    =item database
51    
52    name of C<estmaster> node
53    
54  =item user  =item user
55    
56  C<estmaster> user with read rights  C<estmaster> user with read rights
# Line 76  sub new { Line 81  sub new {
81    
82          my $log = $self->_get_logger;          my $log = $self->_get_logger;
83    
84          foreach my $p (qw/url user passwd/) {          foreach my $p (qw/masterurl user passwd/) {
85                  $log->logdie("need $p") unless ($self->{$p});                  $log->logdie("need $p") unless ($self->{$p});
86          }          }
87    
88          $log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");          my $url = $self->{masterurl} . '/node/' . $self->{database};
89            $self->{url} = $url;
90    
91          $self->{'db'} = HyperEstraier::Node->new($self->{'url'});          $log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");
         $self->{'db'}->set_auth($self->{'user'}, $self->{'passwd'});  
92    
93          my $encoding = $self->{'encoding'} || 'ISO-8859-2';          $self->{db} = Search::Estraier::Node->new;
94          $log->info("using encoding $encoding");          $self->{db}->set_url($self->{'url'});
95            $self->{db}->set_auth($self->{'user'}, $self->{'passwd'});
96    
97          $self->{'iconv'} = new Text::Iconv('UTF-8', $encoding) or          $self->{'encoding'} ||= 'ISO-8859-2';
98                  $log->die("can't create conversion from UTF-8 to $encoding");          $log->info("using encoding ",$self->{encoding});
99    
100          $self ? return $self : return undef;          $self ? return $self : return undef;
101  }  }
# Line 100  sub new { Line 106  sub new {
106  Locate items in index  Locate items in index
107    
108    my @results = $est->search(    my @results = $est->search(
109          query => 'name of book or novel',          phrase => 'name of book or novel',
110          attr => qw/PersonalName TitleProper/,          add_attr => [
111                    "filepath ISTRINC $q",
112                    "size NUMGT 100",
113            ],
114            get_attr => qw/PersonalName TitleProper/,
115            order => 'NUMD',
116            max => 100,
117            options => $HyperEstraier::Condition::SURE,
118            page => 42,
119            depth => 0,
120    );    );
121    
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.
124    
125  Results are returned as hash array with keys named by attributes  Results are returned as hash array with keys named by attributes
126    
127    Pages are numbered C< 1 ... hits/max >.
128    
129  =cut  =cut
130    
131  sub search {  sub search {
# Line 115  sub search { Line 135  sub search {
135    
136          my $log = $self->_get_logger;          my $log = $self->_get_logger;
137    
138          $log->logconfess('need db in object') unless ($self->{'db'});          #$log->debug( 'search args: ' . Dumper($args) );
139          $log->logconfess('need attr') unless ($args->{'attr'});  
140            $self->confess('need db in object') unless ($self->{db});
141            $self->confess('need get_attr') unless ($args->{get_attr});
142    
143          $log->logconfess("need attr as array not " . ref($args->{'attr'}) ) unless (ref($args->{'attr'}) eq 'ARRAY');          $self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');
144    
145          my $q = $args->{'query'};          my $q = $args->{phrase};
146    
147          my $cond = HyperEstraier::Condition->new();          $log->debug("args: " . Dumper( $args ));
148  #       $cond->add_attr("filepath ISTRINC $q");  
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} }) );
152                    map {
153                            $cond->add_attr( $self->convert( $_ ) );
154                            $log->debug(" + $_");
155                    } @{ $args->{add_attr} };
156            };
157    
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});
161    
162            my $max = $args->{max} || 7;
163            my $page = $args->{page} || 1;
164            if ($page < 1) {
165                    $log->warn("page number $page < 1");
166                    $page = 1;
167            }
168    
169          $cond->set_phrase( $self->{'iconv'}->convert( $q ) ) if ($q);          $cond->set_max( $page * $max );
         $cond->set_max( $args->{'max'} ) if ($args->{'max'});  
 #       $cond->set_options( $HyperEstraier::Condition::SURE );  
 #       $cond->set_order( 'NUMD' );  
170    
171          my $result = $self->{'db'}->search($cond, 0) ||          my $result = $self->{db}->search($cond, ( $args->{depth} || 0 )) ||
172                  $log->die("can't search for ", sub { Dumper( $args ) });                  $log->logdie("can't search for ", sub { Dumper( $args ) });
173    
174          my $hits = $result->doc_num;          my $hits = $result->doc_num;
175          $log->debug("found $hits hits for '$q'");          $log->debug("found $hits hits for '$q'");
176    
177          my @results;          my @results;
178    
179          for my $i ( 0 .. ( $hits - 1 ) ) {          for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {
180    
181                  #$log->debug("get_doc($i)");                  #$log->debug("get_doc($i)");
182                  my $doc = $result->get_doc( $i );                  my $doc = $result->get_doc( $i );
# Line 149  sub search { Line 187  sub search {
187    
188                  my $hash;                  my $hash;
189    
190                  foreach my $attr (@{ $args->{'attr'} }) {                  foreach my $attr (@{ $args->{get_attr} }) {
191                          my $val = $doc->attr( $attr );                          my $val = $doc->attr( $attr );
192                          #$log->debug("attr $attr = ", $val || 'undef');                          #$log->debug("attr $attr = ", $val || 'undef');
193                          $hash->{$attr} = $self->{'iconv'}->convert( $val ) if (defined($val));                          $hash->{$attr} = $self->convert( $val ) if (defined($val));
194                  }                  }
195    
196                  if ($hash) {                  if ($hash) {
# Line 161  sub search { Line 199  sub search {
199    
200          }          }
201    
202          $log->debug("results " . Dumper( \@results ));  #       $log->debug("results " . Dumper( \@results ));
203    
204          $log->logconfess("expected to return array") unless (wantarray);          $self->confess("expected to return array") unless (wantarray);
205    
206          return @results;          return @results;
207  }  }
# Line 179  C<die>. Line 217  C<die>.
217  sub confess {  sub confess {
218          my $self = shift;          my $self = shift;
219          if (my $log = $self->{'log'}) {          if (my $log = $self->{'log'}) {
220                  if ($log->can('confess')) {                  if ($log->can('logconfess')) {
221                          $log->confess(@_);                          $log->logconfess(@_);
222                  } elsif ($log->can('fatal')) {                  } elsif ($log->can('fatal')) {
223                          $log->fatal(@_);                          $log->fatal(@_);
224                            die @_;
225                  } elsif ($log->can('error')) {                  } elsif ($log->can('error')) {
226                          $log->error(@_);                          $log->error(@_);
227                  } else {                  } else {
# Line 193  sub confess { Line 232  sub confess {
232          }          }
233  }  }
234    
235    =head2 convert
236    
237    convert internal encoding to UTF-8
238    
239      my $utf8 = $self->convert( $text );
240    
241    =cut
242    
243    sub convert {
244            my $self = shift;
245    
246            my $text = shift || return;
247    
248            from_to($text, $self->{encoding}, 'UTF-8');
249            return $text;
250    }
251    
252    
253  =head2 _get_logger  =head2 _get_logger
254    
255  For compatibility with same method from L<WebPAC::Common>, but without  For compatibility with same method from L<WebPAC::Common>, but without
Legend:
Removed from v.86  
changed lines
  Added in v.535
  ViewVC Help
Powered by ViewVC 1.1.26