--- trunk/Estraier.pm 2006/01/28 19:41:59 100 +++ trunk/Estraier.pm 2006/02/19 17:13:57 108 @@ -4,7 +4,7 @@ use strict; use warnings; -our $VERSION = '0.04_1'; +our $VERSION = '0.04_2'; =head1 NAME @@ -17,9 +17,11 @@ use Search::Estraier; # create and configure node - my $node = new Search::Estraier::Node; - $node->set_url("http://localhost:1978/node/test"); - $node->set_auth("admin","admin"); + my $node = new Search::Estraier::Node( + url => 'http://localhost:1978/node/test', + user => 'admin', + passwd => 'admin' + ); # create document my $doc = new Search::Estraier::Document; @@ -32,16 +34,19 @@ $doc->add_text("Somewhere over the rainbow. Way up high."); $doc->add_text("There's a land that I heard of once in a lullaby."); - die "error: ", $node->status,"\n" unless ($node->put_doc($doc)); + die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) }); =head2 Simple searcher use Search::Estraier; # create and configure node - my $node = new Search::Estraier::Node; - $node->set_url("http://localhost:1978/node/test"); - $node->set_auth("admin","admin"); + my $node = new Search::Estraier::Node( + url => 'http://localhost:1978/node/test', + user => 'admin', + passwd => 'admin', + croak_on_error => 1, + ); # create condition my $cond = new Search::Estraier::Condition; @@ -50,9 +55,10 @@ $cond->set_phrase("rainbow AND lullaby"); my $nres = $node->search($cond, 0); - print "Got ", $nres->hits, " results\n"; if (defined($nres)) { + print "Got ", $nres->hits, " results\n"; + # for each document in results for my $i ( 0 ... $nres->doc_num - 1 ) { # get result document @@ -783,7 +789,7 @@ return $self->{hints}->{$key}; } -=head2 hits +=head2 hints More perlish version of C. This one returns hash. @@ -1166,12 +1172,14 @@ my $id = $node->uri_to_id( 'file:///document/uri/42' ); +This method won't croak, even if using C. + =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 ); } @@ -1231,6 +1239,7 @@ 'application/x-www-form-urlencoded', $arg, \$resbody, + $a->{croak_on_error}, ); return if ($rv != 200); @@ -1499,7 +1508,9 @@ 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; @@ -1543,7 +1554,7 @@ ($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; @@ -1648,11 +1659,57 @@ 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->{name}); + return $self->{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->{name}); + return $self->{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->{name}); + return $self->{links}; } @@ -1683,11 +1740,28 @@ return if ($rv != 200 || !$resbody); - # it seems that response can have multiple line endings - $resbody =~ s/[\r\n]+$//; - + my @lines = split(/[\r\n]/,$resbody); + ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) = - split(/\t/, $resbody, 5); + split(/\t/, shift @lines, 5); + + return $resbody unless (@lines); + + shift @lines; + + while(my $admin = shift @lines) { + push @{$self->{admins}}, $admin; + } + + while(my $guest = shift @lines) { + push @{$self->{guests}}, $guest; + } + + while(my $link = shift @lines) { + push @{$self->{links}}, $link; + } + + return $resbody; }