--- trunk/Estraier.pm 2006/01/28 19:46:20 102 +++ trunk/Estraier.pm 2006/03/12 15:20:06 112 @@ -4,7 +4,7 @@ use strict; use warnings; -our $VERSION = '0.04_1'; +our $VERSION = '0.04'; =head1 NAME @@ -789,7 +789,7 @@ return $self->{hints}->{$key}; } -=head2 hits +=head2 hints More perlish version of C. This one returns hash. @@ -874,14 +874,12 @@ 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) { @@ -894,6 +892,12 @@ warn "## Node debug on\n" if ($self->{debug}); } + $self->{inform} = { + dnum => -1, + wnum => -1, + size => -1.0, + }; + $self ? return $self : return undef; } @@ -1172,12 +1176,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 ); } @@ -1237,6 +1243,7 @@ 'application/x-www-form-urlencoded', $arg, \$resbody, + $a->{croak_on_error}, ); return if ($rv != 200); @@ -1267,8 +1274,8 @@ sub name { my $self = shift; - $self->_set_info unless ($self->{name}); - return $self->{name}; + $self->_set_info unless ($self->{inform}->{name}); + return $self->{inform}->{name}; } @@ -1280,8 +1287,8 @@ sub label { my $self = shift; - $self->_set_info unless ($self->{label}); - return $self->{label}; + $self->_set_info unless ($self->{inform}->{label}); + return $self->{inform}->{label}; } @@ -1293,8 +1300,8 @@ sub doc_num { my $self = shift; - $self->_set_info if ($self->{dnum} < 0); - return $self->{dnum}; + $self->_set_info if ($self->{inform}->{dnum} < 0); + return $self->{inform}->{dnum}; } @@ -1306,8 +1313,8 @@ sub word_num { my $self = shift; - $self->_set_info if ($self->{wnum} < 0); - return $self->{wnum}; + $self->_set_info if ($self->{inform}->{wnum} < 0); + return $self->{inform}->{wnum}; } @@ -1319,8 +1326,8 @@ sub size { my $self = shift; - $self->_set_info if ($self->{size} < 0); - return $self->{size}; + $self->_set_info if ($self->{inform}->{size} < 0); + return $self->{inform}->{size}; } @@ -1505,7 +1512,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; @@ -1549,7 +1558,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; @@ -1654,11 +1663,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->{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}; } @@ -1689,11 +1744,30 @@ 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->{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} ) = - split(/\t/, $resbody, 5); + return $resbody; }