/[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 62 by dpavlin, Sat Jan 7 02:40:57 2006 UTC revision 132 by dpavlin, Mon May 8 21:33:37 2006 UTC
# Line 4  use 5.008; Line 4  use 5.008;
4  use strict;  use strict;
5  use warnings;  use warnings;
6    
7  our $VERSION = '0.01';  our $VERSION = '0.06_1';
8    
9  =head1 NAME  =head1 NAME
10    
# Line 12  Search::Estraier - pure perl module to u Line 12  Search::Estraier - pure perl module to u
12    
13  =head1 SYNOPSIS  =head1 SYNOPSIS
14    
15    use Search::Estraier;  =head2 Simple indexer
16    my $est = new Search::Estraier();  
17            use Search::Estraier;
18    
19            # create and configure node
20            my $node = new Search::Estraier::Node(
21                    url => 'http://localhost:1978/node/test',
22                    user => 'admin',
23                    passwd => 'admin'
24            );
25    
26            # create document
27            my $doc = new Search::Estraier::Document;
28    
29            # add attributes
30            $doc->add_attr('@uri', "http://estraier.gov/example.txt");
31            $doc->add_attr('@title', "Over the Rainbow");
32    
33            # add body text to document
34            $doc->add_text("Somewhere over the rainbow.  Way up high.");
35            $doc->add_text("There's a land that I heard of once in a lullaby.");
36    
37            die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
38    
39    =head2 Simple searcher
40    
41            use Search::Estraier;
42    
43            # create and configure node
44            my $node = new Search::Estraier::Node(
45                    url => 'http://localhost:1978/node/test',
46                    user => 'admin',
47                    passwd => 'admin',
48                    croak_on_error => 1,
49            );
50    
51            # create condition
52            my $cond = new Search::Estraier::Condition;
53    
54            # set search phrase
55            $cond->set_phrase("rainbow AND lullaby");
56    
57            my $nres = $node->search($cond, 0);
58    
59            if (defined($nres)) {
60                    print "Got ", $nres->hits, " results\n";
61    
62                    # for each document in results
63                    for my $i ( 0 ... $nres->doc_num - 1 ) {
64                            # get result document
65                            my $rdoc = $nres->get_doc($i);
66                            # display attribte
67                            print "URI: ", $rdoc->attr('@uri'),"\n";
68                            print "Title: ", $rdoc->attr('@title'),"\n";
69                            print $rdoc->snippet,"\n";
70                    }
71            } else {
72                    die "error: ", $node->status,"\n";
73            }
74    
75  =head1 DESCRIPTION  =head1 DESCRIPTION
76    
# Line 25  or Hyper Estraier development files on t Line 82  or Hyper Estraier development files on t
82  It is implemented as multiple packages which closly resamble Ruby  It is implemented as multiple packages which closly resamble Ruby
83  implementation. It also includes methods to manage nodes.  implementation. It also includes methods to manage nodes.
84    
85    There are few examples in C<scripts> directory of this distribution.
86    
87  =cut  =cut
88    
89  =head1 Inheritable common methods  =head1 Inheritable common methods
# Line 41  Remove multiple whitespaces from string, Line 100  Remove multiple whitespaces from string,
100  =cut  =cut
101    
102  sub _s {  sub _s {
103          my $text = $_[1] || return;          my $text = $_[1];
104            return unless defined($text);
105          $text =~ s/\s\s+/ /gs;          $text =~ s/\s\s+/ /gs;
106          $text =~ s/^\s+//;          $text =~ s/^\s+//;
107          $text =~ s/\s+$//;          $text =~ s/\s+$//;
# Line 106  sub new { Line 166  sub new {
166                          } elsif ($line =~ m/^$/) {                          } elsif ($line =~ m/^$/) {
167                                  $in_text = 1;                                  $in_text = 1;
168                                  next;                                  next;
169                          } elsif ($line =~ m/^(.+)=(.+)$/) {                          } elsif ($line =~ m/^(.+)=(.*)$/) {
170                                  $self->{attrs}->{ $1 } = $2;                                  $self->{attrs}->{ $1 } = $2;
171                                  next;                                  next;
172                          }                          }
173    
174                          warn "draft ignored: $line\n";                          warn "draft ignored: '$line'\n";
175                  }                  }
176          }          }
177    
# Line 269  sub dump_draft { Line 329  sub dump_draft {
329          my $draft;          my $draft;
330    
331          foreach my $attr_name (sort keys %{ $self->{attrs} }) {          foreach my $attr_name (sort keys %{ $self->{attrs} }) {
332                  $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";                  next unless defined(my $v = $self->{attrs}->{$attr_name});
333                    $draft .= $attr_name . '=' . $v . "\n";
334          }          }
335    
336          if ($self->{kwords}) {          if ($self->{kwords}) {
# Line 317  sub delete { Line 378  sub delete {
378    
379  package Search::Estraier::Condition;  package Search::Estraier::Condition;
380    
381  use Carp qw/confess croak/;  use Carp qw/carp confess croak/;
382    
383  use Search::Estraier;  use Search::Estraier;
384  our @ISA = qw/Search::Estraier/;  our @ISA = qw/Search::Estraier/;
# Line 395  sub set_max { Line 456  sub set_max {
456    
457  =head2 set_options  =head2 set_options
458    
459    $cond->set_options( SURE => 1 );    $cond->set_options( 'SURE' );
460    
461      $cond->set_options( qw/AGITO NOIDF SIMPLE/ );
462    
463    Possible options are:
464    
465    =over 8
466    
467    =item SURE
468    
469    check every N-gram
470    
471    =item USUAL
472    
473    check every second N-gram
474    
475    =item FAST
476    
477    check every third N-gram
478    
479    =item AGITO
480    
481    check every fourth N-gram
482    
483    =item NOIDF
484    
485    don't perform TF-IDF tuning
486    
487    =item SIMPLE
488    
489    use simplified query phrase
490    
491    =back
492    
493    Skipping N-grams will speed up search, but reduce accuracy. Every call to C<set_options> will reset previous
494    options;
495    
496    This option changed in version C<0.04> of this module. It's backwards compatibile.
497    
498  =cut  =cut
499    
500  my $options = {  my $options = {
         # check N-gram keys skipping by three  
501          SURE => 1 << 0,          SURE => 1 << 0,
         # check N-gram keys skipping by two  
502          USUAL => 1 << 1,          USUAL => 1 << 1,
         # without TF-IDF tuning  
503          FAST => 1 << 2,          FAST => 1 << 2,
         # with the simplified phrase  
504          AGITO => 1 << 3,          AGITO => 1 << 3,
         # check every N-gram key  
505          NOIDF => 1 << 4,          NOIDF => 1 << 4,
         # check N-gram keys skipping by one  
506          SIMPLE => 1 << 10,          SIMPLE => 1 << 10,
507  };  };
508    
509  sub set_options {  sub set_options {
510          my $self = shift;          my $self = shift;
511          my $option = shift;          my $opt = 0;
512          confess "unknown option" unless ($options->{$option});          foreach my $option (@_) {
513          $self->{options} ||= $options->{$option};                  my $mask;
514                    unless ($mask = $options->{$option}) {
515                            if ($option eq '1') {
516                                    next;
517                            } else {
518                                    croak "unknown option $option";
519                            }
520                    }
521                    $opt += $mask;
522            }
523            $self->{options} = $opt;
524  }  }
525    
526    
# Line 497  sub options { Line 599  sub options {
599  }  }
600    
601    
602    =head2 set_skip
603    
604    Set number of skipped documents from beginning of results
605    
606      $cond->set_skip(42);
607    
608    Similar to C<offset> in RDBMS.
609    
610    =cut
611    
612    sub set_skip {
613            my $self = shift;
614            $self->{skip} = shift;
615    }
616    
617    =head2 skip
618    
619    Return skip for this condition.
620    
621      print $cond->skip;
622    
623    =cut
624    
625    sub skip {
626            my $self = shift;
627            return $self->{skip};
628    }
629    
630    
631  package Search::Estraier::ResultDocument;  package Search::Estraier::ResultDocument;
632    
633  use Carp qw/croak/;  use Carp qw/croak/;
# Line 640  Return number of documents Line 771  Return number of documents
771    
772    print $res->doc_num;    print $res->doc_num;
773    
774    This will return real number of documents (limited by C<max>).
775    If you want to get total number of hits, see C<hits>.
776    
777  =cut  =cut
778    
779  sub doc_num {  sub doc_num {
# Line 671  sub get_doc { Line 805  sub get_doc {
805    
806  Return specific hint from results.  Return specific hint from results.
807    
808    print $rec->hint( 'VERSION' );    print $res->hint( 'VERSION' );
809    
810  Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,  Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,
811  C<TIME>, C<LINK#n>, C<VIEW>.  C<TIME>, C<LINK#n>, C<VIEW>.
# Line 684  sub hint { Line 818  sub hint {
818          return $self->{hints}->{$key};          return $self->{hints}->{$key};
819  }  }
820    
821    =head2 hints
822    
823    More perlish version of C<hint>. This one returns hash.
824    
825      my %hints = $res->hints;
826    
827    =cut
828    
829    sub hints {
830            my $self = shift;
831            return $self->{hints};
832    }
833    
834    =head2 hits
835    
836    Syntaxtic sugar for total number of hits for this query
837    
838      print $res->hits;
839    
840    It's same as
841    
842      print $res->hint('HIT');
843    
844    but shorter.
845    
846    =cut
847    
848    sub hits {
849            my $self = shift;
850            return $self->{hints}->{'HIT'} || 0;
851    }
852    
853  package Search::Estraier::Node;  package Search::Estraier::Node;
854    
# Line 699  use URI::Escape qw/uri_escape/; Line 864  use URI::Escape qw/uri_escape/;
864    
865    my $node = new Search::HyperEstraier::Node;    my $node = new Search::HyperEstraier::Node;
866    
867    or optionally with C<url> as parametar
868    
869      my $node = new Search::HyperEstraier::Node( 'http://localhost:1978/node/test' );
870    
871    or in more verbose form
872    
873      my $node = new Search::HyperEstraier::Node(
874            url => 'http://localhost:1978/node/test',
875            user => 'admin',
876            passwd => 'admin'
877            debug => 1,
878            croak_on_error => 1
879      );
880    
881    with following arguments:
882    
883    =over 4
884    
885    =item url
886    
887    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
898    
899    dumps a B<lot> of debugging output
900    
901    =item croak_on_error
902    
903    very helpful during development. It will croak on all errors instead of
904    silently returning C<-1> (which is convention of Hyper Estraier API in other
905    languages).
906    
907    =back
908    
909  =cut  =cut
910    
911  sub new {  sub new {
# Line 706  sub new { Line 913  sub new {
913          my $self = {          my $self = {
914                  pxport => -1,                  pxport => -1,
915                  timeout => 0,   # this used to be -1                  timeout => 0,   # this used to be -1
                 dnum => -1,  
                 wnum => -1,  
                 size => -1.0,  
916                  wwidth => 480,                  wwidth => 480,
917                  hwidth => 96,                  hwidth => 96,
918                  awidth => 96,                  awidth => 96,
919                  status => -1,                  status => -1,
920          };          };
921    
922          bless($self, $class);          bless($self, $class);
923    
924          my $args = {@_};          if ($#_ == 0) {
925                    $self->{url} = shift;
926            } else {
927                    %$self = ( %$self, @_ );
928    
929                    $self->set_auth( $self->{user}, $self->{passwd} ) if ($self->{user});
930    
931          $self->{debug} = $args->{debug};                  warn "## Node debug on\n" if ($self->{debug});
932          warn "## Node debug on\n" if ($self->{debug});          }
933    
934            $self->{inform} = {
935                    dnum => -1,
936                    wnum => -1,
937                    size => -1.0,
938            };
939    
940          $self ? return $self : return undef;          $self ? return $self : return undef;
941  }  }
# Line 999  Get ID of document specified by URI Line 1215  Get ID of document specified by URI
1215    
1216    my $id = $node->uri_to_id( 'file:///document/uri/42' );    my $id = $node->uri_to_id( 'file:///document/uri/42' );
1217    
1218    This method won't croak, even if using C<croak_on_error>.
1219    
1220  =cut  =cut
1221    
1222  sub uri_to_id {  sub uri_to_id {
1223          my $self = shift;          my $self = shift;
1224          my $uri = shift || return;          my $uri = shift || return;
1225          return $self->_fetch_doc( uri => $uri, path => '/uri_to_id', chomp_resbody => 1 );          return $self->_fetch_doc( uri => $uri, path => '/uri_to_id', chomp_resbody => 1, croak_on_error => 0 );
1226  }  }
1227    
1228    
# Line 1064  sub _fetch_doc { Line 1282  sub _fetch_doc {
1282                  'application/x-www-form-urlencoded',                  'application/x-www-form-urlencoded',
1283                  $arg,                  $arg,
1284                  \$resbody,                  \$resbody,
1285                    $a->{croak_on_error},
1286          );          );
1287    
1288          return if ($rv != 200);          return if ($rv != 200);
# Line 1094  sub _fetch_doc { Line 1313  sub _fetch_doc {
1313    
1314  sub name {  sub name {
1315          my $self = shift;          my $self = shift;
1316          $self->_set_info unless ($self->{name});          $self->_set_info unless ($self->{inform}->{name});
1317          return $self->{name};          return $self->{inform}->{name};
1318  }  }
1319    
1320    
# Line 1107  sub name { Line 1326  sub name {
1326    
1327  sub label {  sub label {
1328          my $self = shift;          my $self = shift;
1329          $self->_set_info unless ($self->{label});          $self->_set_info unless ($self->{inform}->{label});
1330          return $self->{label};          return $self->{inform}->{label};
1331  }  }
1332    
1333    
# Line 1120  sub label { Line 1339  sub label {
1339    
1340  sub doc_num {  sub doc_num {
1341          my $self = shift;          my $self = shift;
1342          $self->_set_info if ($self->{dnum} < 0);          $self->_set_info if ($self->{inform}->{dnum} < 0);
1343          return $self->{dnum};          return $self->{inform}->{dnum};
1344  }  }
1345    
1346    
# Line 1133  sub doc_num { Line 1352  sub doc_num {
1352    
1353  sub word_num {  sub word_num {
1354          my $self = shift;          my $self = shift;
1355          $self->_set_info if ($self->{wnum} < 0);          $self->_set_info if ($self->{inform}->{wnum} < 0);
1356          return $self->{wnum};          return $self->{inform}->{wnum};
1357  }  }
1358    
1359    
# Line 1146  sub word_num { Line 1365  sub word_num {
1365    
1366  sub size {  sub size {
1367          my $self = shift;          my $self = shift;
1368          $self->_set_info if ($self->{size} < 0);          $self->_set_info if ($self->{inform}->{size} < 0);
1369          return $self->{size};          return $self->{inform}->{size};
1370  }  }
1371    
1372    
# Line 1180  sub search { Line 1399  sub search {
1399          );          );
1400          return if ($rv != 200);          return if ($rv != 200);
1401    
1402          my (@docs, $hints);          my @records     = split /--------\[.*?\]--------(?::END)?\r?\n/, $resbody;
1403            my $hintsText   = splice @records, 0, 2; # starts with empty record
1404          my @lines = split(/\n/, $resbody);          my $hints               = { $hintsText =~ m/^(.*?)\t(.*?)$/gsm };
1405          return unless (@lines);  
1406            # process records
1407          my $border = $lines[0];          my $docs = [];
1408          my $isend = 0;          foreach my $record (@records)
1409          my $lnum = 1;          {
1410                    # split into keys and snippets
1411          while ( $lnum <= $#lines ) {                  my ($keys, $snippet) = $record =~ m/^(.*?)\n\n(.*?)$/s;
1412                  my $line = $lines[$lnum];  
1413                  $lnum++;                  # create document hash
1414                    my $doc                         = { $keys =~ m/^(.*?)=(.*?)$/gsm };
1415                  #warn "## $line\n";                  $doc->{'@keywords'}     = $doc->{keywords};
1416                  if ($line && $line =~ m/^\Q$border\E(:END)*$/) {                  ($doc->{keywords})      = $keys =~ m/^%VECTOR\t(.*?)$/gm;
1417                          $isend = $1;                  $doc->{snippet}         = $snippet;
1418                          last;  
1419                  }                  push @$docs, new Search::Estraier::ResultDocument(
1420                            attrs           => $doc,
1421                  if ($line =~ /\t/) {                          uri             => $doc->{'@uri'},
1422                          my ($k,$v) = split(/\t/, $line, 2);                          snippet         => $snippet,
1423                          $hints->{$k} = $v;                          keywords        => $doc->{'keywords'},
1424                  }                  );
         }  
   
         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;  
1425          }          }
1426    
1427          #warn Dumper(\@docs, $hints);          return new Search::Estraier::NodeResult( docs => $docs, hints => $hints );
   
         return new Search::Estraier::NodeResult( docs => \@docs, hints => $hints );  
1428  }  }
1429    
1430    
# Line 1288  sub cond_to_query { Line 1451  sub cond_to_query {
1451    
1452          if (my @attrs = $cond->attrs) {          if (my @attrs = $cond->attrs) {
1453                  for my $i ( 0 .. $#attrs ) {                  for my $i ( 0 .. $#attrs ) {
1454                          push @args,'attr' . ($i+1) . '=' . uri_escape( $attrs[$i] );                          push @args,'attr' . ($i+1) . '=' . uri_escape( $attrs[$i] ) if ($attrs[$i]);
1455                  }                  }
1456          }          }
1457    
# Line 1310  sub cond_to_query { Line 1473  sub cond_to_query {
1473          push @args, 'wwidth=' . $self->{wwidth};          push @args, 'wwidth=' . $self->{wwidth};
1474          push @args, 'hwidth=' . $self->{hwidth};          push @args, 'hwidth=' . $self->{hwidth};
1475          push @args, 'awidth=' . $self->{awidth};          push @args, 'awidth=' . $self->{awidth};
1476            push @args, 'skip=' . $self->{skip} if ($self->{skip});
1477    
1478          return join('&', @args);          return join('&', @args);
1479  }  }
# Line 1317  sub cond_to_query { Line 1481  sub cond_to_query {
1481    
1482  =head2 shuttle_url  =head2 shuttle_url
1483    
1484  This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node  This is method which uses C<LWP::UserAgent> to communicate with Hyper Estraier node
1485  master.  master.
1486    
1487    my $rv = shuttle_url( $url, $content_type, $req_body, \$resbody );    my $rv = shuttle_url( $url, $content_type, $req_body, \$resbody );
# Line 1332  use LWP::UserAgent; Line 1496  use LWP::UserAgent;
1496  sub shuttle_url {  sub shuttle_url {
1497          my $self = shift;          my $self = shift;
1498    
1499          my ($url, $content_type, $reqbody, $resbody) = @_;          my ($url, $content_type, $reqbody, $resbody, $croak_on_error) = @_;
1500    
1501            $croak_on_error = $self->{croak_on_error} unless defined($croak_on_error);
1502    
1503          $self->{status} = -1;          $self->{status} = -1;
1504    
# Line 1359  sub shuttle_url { Line 1525  sub shuttle_url {
1525    
1526          $req->headers->header( 'Host' => $url->host . ":" . $url->port );          $req->headers->header( 'Host' => $url->host . ":" . $url->port );
1527          $req->headers->header( 'Connection', 'close' );          $req->headers->header( 'Connection', 'close' );
1528          $req->headers->header( 'Authorization', 'Basic ' . $self->{auth} );          $req->headers->header( 'Authorization', 'Basic ' . $self->{auth} ) if ($self->{auth});
1529          $req->content_type( $content_type );          $req->content_type( $content_type );
1530    
1531          warn $req->headers->as_string,"\n" if ($self->{debug});          warn $req->headers->as_string,"\n" if ($self->{debug});
# Line 1373  sub shuttle_url { Line 1539  sub shuttle_url {
1539    
1540          warn "## response status: ",$res->status_line,"\n" if ($self->{debug});          warn "## response status: ",$res->status_line,"\n" if ($self->{debug});
1541    
         return -1 if (! $res->is_success);  
   
1542          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);
1543    
1544            if (! $res->is_success) {
1545                    if ($croak_on_error) {
1546                            croak("can't get $url: ",$res->status_line);
1547                    } else {
1548                            return -1;
1549                    }
1550            }
1551    
1552          $$resbody .= $res->content;          $$resbody .= $res->content;
1553    
1554          warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug});          warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug});
# Line 1475  sub set_link { Line 1647  sub set_link {
1647          my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);          my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);
1648          $reqbody .= '&credit=' . $credit if ($credit > 0);          $reqbody .= '&credit=' . $credit if ($credit > 0);
1649    
1650          $self->shuttle_url( $self->{url} . '/_set_link',          if ($self->shuttle_url( $self->{url} . '/_set_link',
1651                  'text/plain',                  'application/x-www-form-urlencoded',
1652                  $reqbody,                  $reqbody,
1653                  undef                  undef
1654          ) == 200;          ) == 200) {
1655                    # refresh node info after adding link
1656                    $self->_set_info;
1657                    return 1;
1658            }
1659    }
1660    
1661    =head2 admins
1662    
1663     my @admins = @{ $node->admins };
1664    
1665    Return array of users with admin rights on node
1666    
1667    =cut
1668    
1669    sub admins {
1670            my $self = shift;
1671            $self->_set_info unless ($self->{inform}->{name});
1672            return $self->{inform}->{admins};
1673    }
1674    
1675    =head2 guests
1676    
1677     my @guests = @{ $node->guests };
1678    
1679    Return array of users with guest rights on node
1680    
1681    =cut
1682    
1683    sub guests {
1684            my $self = shift;
1685            $self->_set_info unless ($self->{inform}->{name});
1686            return $self->{inform}->{guests};
1687    }
1688    
1689    =head2 links
1690    
1691     my $links = @{ $node->links };
1692    
1693    Return array of links for this node
1694    
1695    =cut
1696    
1697    sub links {
1698            my $self = shift;
1699            $self->_set_info unless ($self->{inform}->{name});
1700            return $self->{inform}->{links};
1701  }  }
1702    
1703    
# Line 1510  sub _set_info { Line 1728  sub _set_info {
1728    
1729          return if ($rv != 200 || !$resbody);          return if ($rv != 200 || !$resbody);
1730    
1731          # it seems that response can have multiple line endings          my @lines = split(/[\r\n]/,$resbody);
1732          $resbody =~ s/[\r\n]+$//;  
1733            $self->{inform} = {};
1734    
1735            ( $self->{inform}->{name}, $self->{inform}->{label}, $self->{inform}->{dnum},
1736                    $self->{inform}->{wnum}, $self->{inform}->{size} ) = split(/\t/, shift @lines, 5);
1737    
1738            return $resbody unless (@lines);
1739    
1740            shift @lines;
1741    
1742            while(my $admin = shift @lines) {
1743                    push @{$self->{inform}->{admins}}, $admin;
1744            }
1745    
1746            while(my $guest = shift @lines) {
1747                    push @{$self->{inform}->{guests}}, $guest;
1748            }
1749    
1750            while(my $link = shift @lines) {
1751                    push @{$self->{inform}->{links}}, $link;
1752            }
1753    
1754          ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) =          return $resbody;
                 split(/\t/, $resbody, 5);  
1755    
1756  }  }
1757    
# Line 1534  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.62  
changed lines
  Added in v.132
  ViewVC Help
Powered by ViewVC 1.1.26