/[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 102 by dpavlin, Sat Jan 28 19:46:20 2006 UTC revision 108 by dpavlin, Sun Feb 19 17:13:57 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.04_1';  our $VERSION = '0.04_2';
8    
9  =head1 NAME  =head1 NAME
10    
# Line 789  sub hint { Line 789  sub hint {
789          return $self->{hints}->{$key};          return $self->{hints}->{$key};
790  }  }
791    
792  =head2 hits  =head2 hints
793    
794  More perlish version of C<hint>. This one returns hash.  More perlish version of C<hint>. This one returns hash.
795    
# Line 1172  Get ID of document specified by URI Line 1172  Get ID of document specified by URI
1172    
1173    my $id = $node->uri_to_id( 'file:///document/uri/42' );    my $id = $node->uri_to_id( 'file:///document/uri/42' );
1174    
1175    This method won't croak, even if using C<croak_on_error>.
1176    
1177  =cut  =cut
1178    
1179  sub uri_to_id {  sub uri_to_id {
1180          my $self = shift;          my $self = shift;
1181          my $uri = shift || return;          my $uri = shift || return;
1182          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 );
1183  }  }
1184    
1185    
# Line 1237  sub _fetch_doc { Line 1239  sub _fetch_doc {
1239                  'application/x-www-form-urlencoded',                  'application/x-www-form-urlencoded',
1240                  $arg,                  $arg,
1241                  \$resbody,                  \$resbody,
1242                    $a->{croak_on_error},
1243          );          );
1244    
1245          return if ($rv != 200);          return if ($rv != 200);
# Line 1505  use LWP::UserAgent; Line 1508  use LWP::UserAgent;
1508  sub shuttle_url {  sub shuttle_url {
1509          my $self = shift;          my $self = shift;
1510    
1511          my ($url, $content_type, $reqbody, $resbody) = @_;          my ($url, $content_type, $reqbody, $resbody, $croak_on_error) = @_;
1512    
1513            $croak_on_error = $self->{croak_on_error} unless defined($croak_on_error);
1514    
1515          $self->{status} = -1;          $self->{status} = -1;
1516    
# Line 1549  sub shuttle_url { Line 1554  sub shuttle_url {
1554          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);
1555    
1556          if (! $res->is_success) {          if (! $res->is_success) {
1557                  if ($self->{croak_on_error}) {                  if ($croak_on_error) {
1558                          croak("can't get $url: ",$res->status_line);                          croak("can't get $url: ",$res->status_line);
1559                  } else {                  } else {
1560                          return -1;                          return -1;
# Line 1654  sub set_link { Line 1659  sub set_link {
1659          my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);          my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);
1660          $reqbody .= '&credit=' . $credit if ($credit > 0);          $reqbody .= '&credit=' . $credit if ($credit > 0);
1661    
1662          $self->shuttle_url( $self->{url} . '/_set_link',          if ($self->shuttle_url( $self->{url} . '/_set_link',
1663                  'application/x-www-form-urlencoded',                  'application/x-www-form-urlencoded',
1664                  $reqbody,                  $reqbody,
1665                  undef                  undef
1666          ) == 200;          ) == 200) {
1667                    # refresh node info after adding link
1668                    $self->_set_info;
1669                    return 1;
1670            }
1671    }
1672    
1673    =head2 admins
1674    
1675     my @admins = @{ $node->admins };
1676    
1677    Return array of users with admin rights on node
1678    
1679    =cut
1680    
1681    sub admins {
1682            my $self = shift;
1683            $self->_set_info unless ($self->{name});
1684            return $self->{admins};
1685    }
1686    
1687    =head2 guests
1688    
1689     my @guests = @{ $node->guests };
1690    
1691    Return array of users with guest rights on node
1692    
1693    =cut
1694    
1695    sub guests {
1696            my $self = shift;
1697            $self->_set_info unless ($self->{name});
1698            return $self->{guests};
1699    }
1700    
1701    =head2 links
1702    
1703     my $links = @{ $node->links };
1704    
1705    Return array of links for this node
1706    
1707    =cut
1708    
1709    sub links {
1710            my $self = shift;
1711            $self->_set_info unless ($self->{name});
1712            return $self->{links};
1713  }  }
1714    
1715    
# Line 1689  sub _set_info { Line 1740  sub _set_info {
1740    
1741          return if ($rv != 200 || !$resbody);          return if ($rv != 200 || !$resbody);
1742    
1743          # it seems that response can have multiple line endings          my @lines = split(/[\r\n]/,$resbody);
1744          $resbody =~ s/[\r\n]+$//;          
   
1745          ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) =          ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) =
1746                  split(/\t/, $resbody, 5);                  split(/\t/, shift @lines, 5);
1747    
1748            return $resbody unless (@lines);
1749    
1750            shift @lines;
1751    
1752            while(my $admin = shift @lines) {
1753                    push @{$self->{admins}}, $admin;
1754            }
1755            
1756            while(my $guest = shift @lines) {
1757                    push @{$self->{guests}}, $guest;
1758            }
1759    
1760            while(my $link = shift @lines) {
1761                    push @{$self->{links}}, $link;
1762            }
1763    
1764            return $resbody;
1765    
1766  }  }
1767    
Legend:
Removed from v.102  
changed lines
  Added in v.108
  ViewVC Help
Powered by ViewVC 1.1.26