/[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 212 by dpavlin, Mon Dec 5 17:47:16 2005 UTC
# 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.04
17    
18  =cut  =cut
19    
20  our $VERSION = '0.01';  our $VERSION = '0.04';
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'} = HyperEstraier::Node->new($self->{'url'});
# Line 83  sub new { Line 96  sub new {
96          my $encoding = $self->{'encoding'} || 'ISO-8859-2';          my $encoding = $self->{'encoding'} || 'ISO-8859-2';
97          $log->info("using encoding $encoding");          $log->info("using encoding $encoding");
98    
99          $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or          $self->{'iconv'} = new Text::Iconv('UTF-8', $encoding) or
100                  $log->die("can't create conversion from $encoding to UTF-8");                  $log->die("can't create conversion from UTF-8 to $encoding");
101    
102          $self ? return $self : return undef;          $self ? return $self : return undef;
103  }  }
# Line 94  sub new { Line 107  sub new {
107    
108  Locate items in index  Locate items in index
109    
110    $est->search(    my @results = $est->search(
111          query => 'name of book or novel',          phrase => 'name of book or novel',
112          attr => [ qw/PersonalName Title/ ],          add_attr => [
113                    "filepath ISTRINC $q",
114                    "size NUMGT 100",
115            ],
116            get_attr => qw/PersonalName TitleProper/,
117            order => 'NUMD',
118            max => 100,
119            options => $HyperEstraier::Condition::SURE,
120            page => 42,
121    );    );
122    
123    Options are close match to Hyper Estraier API, except C<get_attr> which defines
124    attributes which will be returned in hash for each record.
125    
126    Results are returned as hash array with keys named by attributes
127    
128    Pages are numbered C< 1 ... hits/max >.
129    
130  =cut  =cut
131    
132  sub search {  sub search {
# Line 108  sub search { Line 136  sub search {
136    
137          my $log = $self->_get_logger;          my $log = $self->_get_logger;
138    
139          $log->logconfess('need db in object') unless ($self->{'db'});          #$log->debug( 'search args: ' . Dumper($args) );
140          $log->logconfess('need attr') unless ($args->{'attr'});  
141          $log->logconfess("need attr as array not " . ref($args->{'attr'}) ) unless (ref($args->{'attr'}) eq 'ARRAY');          $self->confess('need db in object') unless ($self->{db});
142            $self->confess('need get_attr') unless ($args->{get_attr});
143  #       my $database = $self->{'database'} || $log->logconfess('no database in $self');  
144  #       foreach my $p (qw/id ds type/) {          $self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');
145  #               $log->logconfess("need $p") unless ($args->{$p});  
146  #       }          my $q = $args->{phrase};
147    
148            $log->debug("args: " . Dumper( $args ));
149    
150          my $cond = HyperEstraier::Condition->new();          my $cond = HyperEstraier::Condition->new();
151  #       $cond->add_attr("filepath ISTRINC $q");          if ( ref($args->{add_attr}) eq 'ARRAY' ) {
152                    $log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
153                    map {
154                            $cond->add_attr( $self->{iconv}->convert( $_ ) );
155                            $log->debug(" + $_");
156                    } @{ $args->{add_attr} };
157            };
158    
159            $cond->set_phrase( $self->{iconv}->convert($q) ) if ($q);
160            $cond->set_options( $args->{options} ) if ($args->{options});
161            $cond->set_order( $args->{order} ) if ($args->{order});
162    
163            my $max = $args->{max} || 7;
164            my $page = $args->{page} || 1;
165            if ($page < 1) {
166                    $log->warn("page number $page < 1");
167                    $page = 1;
168            }
169    
170          $cond->set_phrase( $args->{'query'} ) if ($args->{'query'});          $cond->set_max( $page * $max );
         $cond->set_max( $args->{'max'} ) if ($args->{'max'});  
 #       $cond->set_options( $HyperEstraier::Condition::SURE );  
 #       $cond->set_order( 'NUMD' );  
171    
172          my $result = $self->{'db'}->search($cond, 0) ||          my $result = $self->{db}->search($cond, 0) ||
173                  $log->die("can't search for ", sub { Dumper( $args ) });                  $log->die("can't search for ", sub { Dumper( $args ) });
174    
175          my $hits = $result->doc_num;          my $hits = $result->doc_num;
176          $log->debug("found $hits hits");          $log->debug("found $hits hits for '$q'");
   
         my @attrs = $args->{'attr'} || $self->confess("need attr");  
177    
178          my @results;          my @results;
179    
180          for my $i ( 0 .. $hits ) {          for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {
181    
182                  $log->debug("get_doc($i)");                  #$log->debug("get_doc($i)");
183                  my $doc = $result->get_doc( $i );                  my $doc = $result->get_doc( $i );
184                  if (! $doc) {                  if (! $doc) {
185                          $log->warn("can't find result $i");                          $log->warn("can't find result $i");
# Line 146  sub search { Line 188  sub search {
188    
189                  my $hash;                  my $hash;
190    
191                  foreach my $attr (@attrs) {                  foreach my $attr (@{ $args->{get_attr} }) {
192                          my $val = $doc->attr( $attr );                          my $val = $doc->attr( $attr );
193                          $log->debug("attr $attr = ", $val || 'undef');                          #$log->debug("attr $attr = ", $val || 'undef');
194                          $hash->{$attr} = $val if (defined($val));                          $hash->{$attr} = $self->{iconv}->convert( $val ) if (defined($val));
195                  }                  }
196    
197                  if ($hash) {                  if ($hash) {
# Line 158  sub search { Line 200  sub search {
200    
201          }          }
202    
203          $log->debug("results " . Dumper( \@results ));  #       $log->debug("results " . Dumper( \@results ));
204    
205          $log->logconfess("expected to return array") unless (wantarray);          $self->confess("expected to return array") unless (wantarray);
206    
207          return @results;          return @results;
208  }  }
# Line 176  C<die>. Line 218  C<die>.
218  sub confess {  sub confess {
219          my $self = shift;          my $self = shift;
220          if (my $log = $self->{'log'}) {          if (my $log = $self->{'log'}) {
221                  if ($log->can('confess')) {                  if ($log->can('logconfess')) {
222                          $log->confess(@_);                          $log->logconfess(@_);
223                  } elsif ($log->can('fatal')) {                  } elsif ($log->can('fatal')) {
224                          $log->fatal(@_);                          $log->fatal(@_);
225                            die @_;
226                  } elsif ($log->can('error')) {                  } elsif ($log->can('error')) {
227                          $log->error(@_);                          $log->error(@_);
228                  } else {                  } else {
Legend:
Removed from v.80  
changed lines
  Added in v.212
  ViewVC Help
Powered by ViewVC 1.1.26