/[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 80 by dpavlin, Mon Nov 21 14:42:16 2005 UTC revision 343 by dpavlin, Sat Jan 7 01:40:01 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 Text::Iconv;
8  use Data::Dumper;  use Data::Dumper;
9    
# 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.06
17    
18  =cut  =cut
19    
20  our $VERSION = '0.01';  our $VERSION = '0.06';
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',
39          log => $Log::Log4Perl->log_object,          log => $Log::Log4perl->log_object,
40   );   );
41    
42  Options are:  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 60  character encoding of C<data_structure> Line 65  character encoding of C<data_structure>
65  (and it probably is). This encoding will be converted to C<UTF-8> for  (and it probably is). This encoding will be converted to C<UTF-8> for
66  Hyper Estraier.  Hyper Estraier.
67    
68    =item log
69    
70    L<Log::Log4perl> object or equivalent (C<< $c->log >> can be used in
71    L<Catalyst> and there is support for it).
72    
73  =back  =back
74    
75  =cut  =cut
# Line 71  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            my $url = $self->{masterurl} . '/node/' . $self->{database};
89            $self->{url} = $url;
90    
91          $log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");          $log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");
92    
93          $self->{'db'} = HyperEstraier::Node->new($self->{'url'});          $self->{db} = Search::Estraier::Node->new;
94          $self->{'db'}->set_auth($self->{'user'}, $self->{'passwd'});          $self->{db}->set_url($self->{'url'});
95            $self->{db}->set_auth($self->{'user'}, $self->{'passwd'});
96    
97          my $encoding = $self->{'encoding'} || 'ISO-8859-2';          my $encoding = $self->{'encoding'} || 'ISO-8859-2';
98          $log->info("using encoding $encoding");          $log->info("using encoding $encoding");
99    
100          $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or          $self->{'iconv'} = new Text::Iconv('UTF-8', $encoding) or
101                  $log->die("can't create conversion from $encoding to UTF-8");                  $log->die("can't create conversion from UTF-8 to $encoding");
102    
103          $self ? return $self : return undef;          $self ? return $self : return undef;
104  }  }
# Line 94  sub new { Line 108  sub new {
108    
109  Locate items in index  Locate items in index
110    
111    $est->search(    my @results = $est->search(
112          query => 'name of book or novel',          phrase => 'name of book or novel',
113          attr => [ qw/PersonalName Title/ ],          add_attr => [
114                    "filepath ISTRINC $q",
115                    "size NUMGT 100",
116            ],
117            get_attr => qw/PersonalName TitleProper/,
118            order => 'NUMD',
119            max => 100,
120            options => $HyperEstraier::Condition::SURE,
121            page => 42,
122            depth => 0,
123    );    );
124    
125    Options are close match to Hyper Estraier API, except C<get_attr> which defines
126    attributes which will be returned in hash for each record.
127    
128    Results are returned as hash array with keys named by attributes
129    
130    Pages are numbered C< 1 ... hits/max >.
131    
132  =cut  =cut
133    
134  sub search {  sub search {
# Line 108  sub search { Line 138  sub search {
138    
139          my $log = $self->_get_logger;          my $log = $self->_get_logger;
140    
141          $log->logconfess('need db in object') unless ($self->{'db'});          #$log->debug( 'search args: ' . Dumper($args) );
         $log->logconfess('need attr') unless ($args->{'attr'});  
         $log->logconfess("need attr as array not " . ref($args->{'attr'}) ) unless (ref($args->{'attr'}) eq 'ARRAY');  
   
 #       my $database = $self->{'database'} || $log->logconfess('no database in $self');  
 #       foreach my $p (qw/id ds type/) {  
 #               $log->logconfess("need $p") unless ($args->{$p});  
 #       }  
   
         my $cond = HyperEstraier::Condition->new();  
 #       $cond->add_attr("filepath ISTRINC $q");  
   
         $cond->set_phrase( $args->{'query'} ) if ($args->{'query'});  
         $cond->set_max( $args->{'max'} ) if ($args->{'max'});  
 #       $cond->set_options( $HyperEstraier::Condition::SURE );  
 #       $cond->set_order( 'NUMD' );  
142    
143          my $result = $self->{'db'}->search($cond, 0) ||          $self->confess('need db in object') unless ($self->{db});
144            $self->confess('need get_attr') unless ($args->{get_attr});
145    
146            $self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');
147    
148            my $q = $args->{phrase};
149    
150            $log->debug("args: " . Dumper( $args ));
151    
152            my $cond = Search::Estraier::Condition->new();
153            if ( ref($args->{add_attr}) eq 'ARRAY' ) {
154                    $log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
155                    map {
156                            $cond->add_attr( $self->{iconv}->convert( $_ ) );
157                            $log->debug(" + $_");
158                    } @{ $args->{add_attr} };
159            };
160    
161            $cond->set_phrase( $self->{iconv}->convert($q) ) if ($q);
162            $cond->set_options( $args->{options} ) if ($args->{options});
163            $cond->set_order( $args->{order} ) if ($args->{order});
164    
165            my $max = $args->{max} || 7;
166            my $page = $args->{page} || 1;
167            if ($page < 1) {
168                    $log->warn("page number $page < 1");
169                    $page = 1;
170            }
171    
172            $cond->set_max( $page * $max );
173    
174            my $result = $self->{db}->search($cond, ( $args->{depth} || 0 )) ||
175                  $log->die("can't search for ", sub { Dumper( $args ) });                  $log->die("can't search for ", sub { Dumper( $args ) });
176    
177          my $hits = $result->doc_num;          my $hits = $result->doc_num;
178          $log->debug("found $hits hits");          $log->debug("found $hits hits for '$q'");
   
         my @attrs = $args->{'attr'} || $self->confess("need attr");  
179    
180          my @results;          my @results;
181    
182          for my $i ( 0 .. $hits ) {          for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {
183    
184                  $log->debug("get_doc($i)");                  #$log->debug("get_doc($i)");
185                  my $doc = $result->get_doc( $i );                  my $doc = $result->get_doc( $i );
186                  if (! $doc) {                  if (! $doc) {
187                          $log->warn("can't find result $i");                          $log->warn("can't find result $i");
# Line 146  sub search { Line 190  sub search {
190    
191                  my $hash;                  my $hash;
192    
193                  foreach my $attr (@attrs) {                  foreach my $attr (@{ $args->{get_attr} }) {
194                          my $val = $doc->attr( $attr );                          my $val = $doc->attr( $attr );
195                          $log->debug("attr $attr = ", $val || 'undef');                          #$log->debug("attr $attr = ", $val || 'undef');
196                          $hash->{$attr} = $val if (defined($val));                          $hash->{$attr} = $self->{iconv}->convert( $val ) if (defined($val));
197                  }                  }
198    
199                  if ($hash) {                  if ($hash) {
# Line 158  sub search { Line 202  sub search {
202    
203          }          }
204    
205          $log->debug("results " . Dumper( \@results ));  #       $log->debug("results " . Dumper( \@results ));
206    
207          $log->logconfess("expected to return array") unless (wantarray);          $self->confess("expected to return array") unless (wantarray);
208    
209          return @results;          return @results;
210  }  }
# Line 176  C<die>. Line 220  C<die>.
220  sub confess {  sub confess {
221          my $self = shift;          my $self = shift;
222          if (my $log = $self->{'log'}) {          if (my $log = $self->{'log'}) {
223                  if ($log->can('confess')) {                  if ($log->can('logconfess')) {
224                          $log->confess(@_);                          $log->logconfess(@_);
225                  } elsif ($log->can('fatal')) {                  } elsif ($log->can('fatal')) {
226                          $log->fatal(@_);                          $log->fatal(@_);
227                            die @_;
228                  } elsif ($log->can('error')) {                  } elsif ($log->can('error')) {
229                          $log->error(@_);                          $log->error(@_);
230                  } else {                  } else {
Legend:
Removed from v.80  
changed lines
  Added in v.343
  ViewVC Help
Powered by ViewVC 1.1.26