/[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!

Diff of /trunk/lib/Search/Estraier.pm

Parent Directory | Revision Log | View Patch Patch

-revision 102 by dpavlin,
Sat Jan 28 19:46:20 2006 UTC
+revision 122 by dpavlin,
Tue May  2 10:19:47 2006 UTC
 Line 4 
 use 5.008;
  use strict;
  use warnings;
- our $VERSION = '0.04_1';
+ our $VERSION = '0.05_1';
  =head1 NAME
 Line 599 
 sub options {
  }
+ =head2 set_skip
+ Set number of skipped documents from beginning of results
+   $cond->set_skip(42);
+ Similar to C<offset> in RDBMS.
+ =cut
+ sub set_skip {
+         my $self = shift;
+         $self->{skip} = shift;
+ }
+ =head2 skip
+ Return skip for this condition.
+   print $cond->skip;
+ =cut
+ sub skip {
+         my $self = shift;
+         return $self->{skip};
+ }
  package Search::Estraier::ResultDocument;
  use Carp qw/croak/;
-Line 789 
 sub hint {
+Line 818 
 sub hint {
          return $self->{hints}->{$key};
  }
- =head2 hits
+ =head2 hints
  More perlish version of C<hint>. This one returns hash.
-Line 874 
 sub new {
+Line 903 
 sub new {
          my $self = {
                  pxport => -1,
                  timeout => 0,   # this used to be -1
-                 dnum => -1,
-                 wnum => -1,
-                 size => -1.0,
                  wwidth => 480,
                  hwidth => 96,
                  awidth => 96,
                  status => -1,
          };
          bless($self, $class);
          if ($#_ == 0) {
-Line 894 
 sub new {
+Line 921 
 sub new {
                  warn "## Node debug on\n" if ($self->{debug});
          }
+         $self->{inform} = {
+                 dnum => -1,
+                 wnum => -1,
+                 size => -1.0,
+         };
          $self ? return $self : return undef;
  }
-Line 1172 
 Get ID of document specified by URI
+Line 1205 
 Get ID of document specified by URI
    my $id = $node->uri_to_id( 'file:///document/uri/42' );
+ This method won't croak, even if using C<croak_on_error>.
  =cut
  sub uri_to_id {
          my $self = shift;
          my $uri = shift || return;
-         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 );
  }
-Line 1237 
 sub _fetch_doc {
+Line 1272 
 sub _fetch_doc {
                  'application/x-www-form-urlencoded',
                  $arg,
                  \$resbody,
+                 $a->{croak_on_error},
          );
          return if ($rv != 200);
-Line 1267 
 sub _fetch_doc {
+Line 1303 
 sub _fetch_doc {
  sub name {
          my $self = shift;
-         $self->_set_info unless ($self->{name});
+         $self->_set_info unless ($self->{inform}->{name});
-         return $self->{name};
+         return $self->{inform}->{name};
  }
-Line 1280 
 sub name {
+Line 1316 
 sub name {
  sub label {
          my $self = shift;
-         $self->_set_info unless ($self->{label});
+         $self->_set_info unless ($self->{inform}->{label});
-         return $self->{label};
+         return $self->{inform}->{label};
  }
-Line 1293 
 sub label {
+Line 1329 
 sub label {
  sub doc_num {
          my $self = shift;
-         $self->_set_info if ($self->{dnum} < 0);
+         $self->_set_info if ($self->{inform}->{dnum} < 0);
-         return $self->{dnum};
+         return $self->{inform}->{dnum};
  }
-Line 1306 
 sub doc_num {
+Line 1342 
 sub doc_num {
  sub word_num {
          my $self = shift;
-         $self->_set_info if ($self->{wnum} < 0);
+         $self->_set_info if ($self->{inform}->{wnum} < 0);
-         return $self->{wnum};
+         return $self->{inform}->{wnum};
  }
-Line 1319 
 sub word_num {
+Line 1355 
 sub word_num {
  sub size {
          my $self = shift;
-         $self->_set_info if ($self->{size} < 0);
+         $self->_set_info if ($self->{inform}->{size} < 0);
-         return $self->{size};
+         return $self->{inform}->{size};
  }
-Line 1483 
 sub cond_to_query {
+Line 1519 
 sub cond_to_query {
          push @args, 'wwidth=' . $self->{wwidth};
          push @args, 'hwidth=' . $self->{hwidth};
          push @args, 'awidth=' . $self->{awidth};
+         push @args, 'skip=' . $self->{skip} if ($self->{skip});
          return join('&', @args);
  }
-Line 1505 
 use LWP::UserAgent;
+Line 1542 
 use LWP::UserAgent;
  sub shuttle_url {
          my $self = shift;
-         my ($url, $content_type, $reqbody, $resbody) = @_;
+         my ($url, $content_type, $reqbody, $resbody, $croak_on_error) = @_;
+         $croak_on_error = $self->{croak_on_error} unless defined($croak_on_error);
          $self->{status} = -1;
-Line 1549 
 sub shuttle_url {
+Line 1588 
 sub shuttle_url {
          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);
          if (! $res->is_success) {
-                 if ($self->{croak_on_error}) {
+                 if ($croak_on_error) {
                          croak("can't get $url: ",$res->status_line);
                  } else {
                          return -1;
-Line 1654 
 sub set_link {
+Line 1693 
 sub set_link {
          my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);
          $reqbody .= '&credit=' . $credit if ($credit > 0);
-         $self->shuttle_url( $self->{url} . '/_set_link',
+         if ($self->shuttle_url( $self->{url} . '/_set_link',
                  'application/x-www-form-urlencoded',
                  $reqbody,
                  undef
-         ) == 200;
+         ) == 200) {
+                 # refresh node info after adding link
+                 $self->_set_info;
+                 return 1;
+         }
+ }
+ =head2 admins
+  my @admins = @{ $node->admins };
+ Return array of users with admin rights on node
+ =cut
+ sub admins {
+         my $self = shift;
+         $self->_set_info unless ($self->{inform}->{name});
+         return $self->{inform}->{admins};
+ }
+ =head2 guests
+  my @guests = @{ $node->guests };
+ Return array of users with guest rights on node
+ =cut
+ sub guests {
+         my $self = shift;
+         $self->_set_info unless ($self->{inform}->{name});
+         return $self->{inform}->{guests};
+ }
+ =head2 links
+  my $links = @{ $node->links };
+ Return array of links for this node
+ =cut
+ sub links {
+         my $self = shift;
+         $self->_set_info unless ($self->{inform}->{name});
+         return $self->{inform}->{links};
  }
-Line 1689 
 sub _set_info {
+Line 1774 
 sub _set_info {
          return if ($rv != 200 || !$resbody);
-         # it seems that response can have multiple line endings
+         my @lines = split(/[\r\n]/,$resbody);
-         $resbody =~ s/[\r\n]+$//;
+         $self->{inform} = {};
+         ( $self->{inform}->{name}, $self->{inform}->{label}, $self->{inform}->{dnum},
+                 $self->{inform}->{wnum}, $self->{inform}->{size} ) = split(/\t/, shift @lines, 5);
+         return $resbody unless (@lines);
+         shift @lines;
+         while(my $admin = shift @lines) {
+                 push @{$self->{inform}->{admins}}, $admin;
+         }
+         while(my $guest = shift @lines) {
+                 push @{$self->{inform}->{guests}}, $guest;
+         }
+         while(my $link = shift @lines) {
+                 push @{$self->{inform}->{links}}, $link;
+         }
-         ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) =
+         return $resbody;
-                 split(/\t/, $resbody, 5);
  }

 Legend:



Removed from v.102
 


changed lines


 
Added in v.122
 Legend:



Removed from v.102
 


changed lines


 
Added in v.122
-Removed from v.102
+Added in v.122

	ViewVC Help
Powered by ViewVC 1.1.26