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

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

revision 126 by dpavlin, Sat May 6 21:38:14 2006 UTC revision 132 by dpavlin, Mon May 8 21:33:37 2006 UTC
# Line 872  or in more verbose form Line 872  or in more verbose form
872    
873    my $node = new Search::HyperEstraier::Node(    my $node = new Search::HyperEstraier::Node(
874          url => 'http://localhost:1978/node/test',          url => 'http://localhost:1978/node/test',
875            user => 'admin',
876            passwd => 'admin'
877          debug => 1,          debug => 1,
878          croak_on_error => 1          croak_on_error => 1
879    );    );
# Line 884  with following arguments: Line 886  with following arguments:
886    
887  URL to node  URL to node
888    
889    =item user
890    
891    specify username for node server authentication
892    
893    =item passwd
894    
895    password for authentication
896    
897  =item debug  =item debug
898    
899  dumps a B<lot> of debugging output  dumps a B<lot> of debugging output
# Line 914  sub new { Line 924  sub new {
924          if ($#_ == 0) {          if ($#_ == 0) {
925                  $self->{url} = shift;                  $self->{url} = shift;
926          } else {          } else {
                 my $args = {@_};  
   
927                  %$self = ( %$self, @_ );                  %$self = ( %$self, @_ );
928    
929                    $self->set_auth( $self->{user}, $self->{passwd} ) if ($self->{user});
930    
931                  warn "## Node debug on\n" if ($self->{debug});                  warn "## Node debug on\n" if ($self->{debug});
932          }          }
933    
# Line 1389  sub search { Line 1399  sub search {
1399          );          );
1400          return if ($rv != 200);          return if ($rv != 200);
1401    
         my (@docs, $hints);  
   
         my @lines = split(/\n/, $resbody);  
         return unless (@lines);  
   
         my $border = $lines[0];  
         my $isend = 0;  
         my $lnum = 1;  
   
         while ( $lnum <= $#lines ) {  
                 my $line = $lines[$lnum];  
                 $lnum++;  
   
                 #warn "## $line\n";  
                 if ($line && $line =~ m/^\Q$border\E(:END)*$/) {  
                         $isend = $1;  
                         last;  
                 }  
   
                 if ($line =~ /\t/) {  
                         my ($k,$v) = split(/\t/, $line, 2);  
                         $hints->{$k} = $v;  
                 }  
         }  
   
         my $snum = $lnum;  
   
         while( ! $isend && $lnum <= $#lines ) {  
                 my $line = $lines[$lnum];  
                 #warn "# $lnum: $line\n";  
                 $lnum++;  
   
                 if ($line && $line =~ m/^\Q$border\E/) {  
                         if ($lnum > $snum) {  
                                 my $rdattrs;  
                                 my $rdvector;  
                                 my $rdsnippet;  
                                   
                                 my $rlnum = $snum;  
                                 while ($rlnum < $lnum - 1 ) {  
                                         #my $rdline = $self->_s($lines[$rlnum]);  
                                         my $rdline = $lines[$rlnum];  
                                         $rlnum++;  
                                         last unless ($rdline);  
                                         if ($rdline =~ /^%/) {  
                                                 $rdvector = $1 if ($rdline =~ /^%VECTOR\t(.+)$/);  
                                         } elsif($rdline =~ /=/) {  
                                                 $rdattrs->{$1} = $2 if ($rdline =~ /^(.+)=(.+)$/);  
                                         } else {  
                                                 confess "invalid format of response";  
                                         }  
                                 }  
                                 while($rlnum < $lnum - 1) {  
                                         my $rdline = $lines[$rlnum];  
                                         $rlnum++;  
                                         $rdsnippet .= "$rdline\n";  
                                 }  
                                 #warn Dumper($rdvector, $rdattrs, $rdsnippet);  
                                 if (my $rduri = $rdattrs->{'@uri'}) {  
                                         push @docs, new Search::Estraier::ResultDocument(  
                                                 uri => $rduri,  
                                                 attrs => $rdattrs,  
                                                 snippet => $rdsnippet,  
                                                 keywords => $rdvector,  
                                         );  
                                 }  
                         }  
                         $snum = $lnum;  
                         #warn "### $line\n";  
                         $isend = 1 if ($line =~ /:END$/);  
                 }  
   
         }  
   
         if (! $isend) {  
                 warn "received result doesn't have :END\n$resbody";  
                 return;  
         }  
   
         #warn Dumper(\@docs, $hints);  
   
         return new Search::Estraier::NodeResult( docs => \@docs, hints => $hints );  
 }  
   
 =head2 search_new  
   
 Better implementation of search by Robert Klep <robert@klep.name>  
   
 =cut  
   
 sub search_new {  
         my $self = shift;  
         my ($cond, $depth) = @_;  
         return unless ($cond && defined($depth) && $self->{url});  
         croak "cond mush be Search::Estraier::Condition, not '$cond->isa'" unless ($cond->isa('Search::Estraier::Condition'));  
         croak "depth needs number, not '$depth'" unless ($depth =~ m/^\d+$/);  
   
         my $resbody;  
   
         my $rv = $self->shuttle_url( $self->{url} . '/search',  
                 'application/x-www-form-urlencoded',  
                 $self->cond_to_query( $cond, $depth ),  
                 \$resbody,  
         );  
         return if ($rv != 200);  
   
1402          my @records     = split /--------\[.*?\]--------(?::END)?\r?\n/, $resbody;          my @records     = split /--------\[.*?\]--------(?::END)?\r?\n/, $resbody;
1403          my $hintsText   = splice @records, 0, 2; # starts with empty record          my $hintsText   = splice @records, 0, 2; # starts with empty record
1404          my $hints               = { $hintsText =~ m/^(.*?)\t(.*?)$/gsm };          my $hints               = { $hintsText =~ m/^(.*?)\t(.*?)$/gsm };
1405    
1406          # process records          # process records
1407          my $docs;          my $docs = [];
1408          foreach my $record (@records)          foreach my $record (@records)
1409          {          {
1410                  # split into keys and snippets                  # split into keys and snippets
# Line 1867  Hyper Estraier Ruby interface on which t Line 1771  Hyper Estraier Ruby interface on which t
1771    
1772  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
1773    
1774    Robert Klep E<lt>robert@klep.nameE<gt> contributed refactored search code
1775    
1776  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
1777    
Legend:
Removed from v.126  
changed lines
  Added in v.132
  ViewVC Help
Powered by ViewVC 1.1.26