/[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 33 by dpavlin, Thu Jan 5 17:54:18 2006 UTC revision 38 by dpavlin, Thu Jan 5 22:27:03 2006 UTC
# Line 661  sub hint { Line 661  sub hint {
661    
662  package Search::Estraier::Node;  package Search::Estraier::Node;
663    
664  use Carp qw/croak/;  use Carp qw/carp croak/;
665  use URI;  use URI;
666  use URI::Escape qw/uri_escape/;  use MIME::Base64;
667  use IO::Socket::INET;  use IO::Socket::INET;
668    
669  =head1 Search::Estraier::Node  =head1 Search::Estraier::Node
# Line 747  Specify name and password for authentica Line 747  Specify name and password for authentica
747  sub set_auth {  sub set_auth {
748          my $self = shift;          my $self = shift;
749          my ($login,$passwd) = @_;          my ($login,$passwd) = @_;
750          $self->{auth} = uri_escape( "$login:$passwd" );          $self->{auth} = encode_base64( "$login:$passwd" );
751  }  }
752    
753  =head2 status  =head2 status
# Line 784  sub shuttle_url { Line 784  sub shuttle_url {
784    
785          my $status = -1;          my $status = -1;
786    
787            warn "## $url\n";
788    
789          $url = new URI($url);          $url = new URI($url);
790          return unless ($url->scheme ne 'http' || ! $url->host || $url->port < 1);          if (
791                            !$url || !$url->scheme || !$url->scheme eq 'http' ||
792                            !$url->host || !$url->port || $url->port < 1
793                    ) {
794                    carp "can't parse $url\n";
795                    return -1;
796            }
797    
798          my ($host,$port,$query) = ($url->host, $url->port, $url->path);          my ($host,$port,$query) = ($url->host, $url->port, $url->path);
799    
# Line 794  sub shuttle_url { Line 802  sub shuttle_url {
802                  $query = "http://$host:$port/$query";                  $query = "http://$host:$port/$query";
803          }          }
804    
805          $query .= '?' + $url->query if ($url->query && ! $reqbody);          $query .= '?' . $url->query if ($url->query && ! $reqbody);
806    
807          my $sock = IO::Socket::INET->new(          my $headers;
                 PeerAddr        => $host,  
                 PeerPort        => $port,  
                 Proto           => 'tcp',  
                 Timeout         => $self->{timeout} || 90,  
         ) || return -1;  
808    
809          if ($reqbody) {          if ($reqbody) {
810                  print $sock "POST $query HTTP/1.0\r\n";                  $headers .= "POST $query HTTP/1.0\r\n";
811          } else {          } else {
812                  print $sock "GET $query HTTP/1.0\r\n";                  $headers .= "GET $query HTTP/1.0\r\n";
813          }          }
814    
815          print $sock "Host: $url->host:$url->port\r\n";          $headers .= "Host: $url->host:$url->port\r\n";
816          print $sock "Connection: close\r\n";          $headers .= "Connection: close\r\n";
817          print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";          $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
818          print $sock "Content-Type $content_type\r\n";          $headers .= "Content-Type $content_type\r\n";
819          print $sock "Authorization: Basic $self->{auth}\r\n";          $headers .= "Authorization: Basic $self->{auth}\r\n";
820            my $len = 0;
821          {          {
822                  use bytes;                  use bytes;
823                  print $sock "Content-Length: ", length($reqbody), "\r\n";                  $len = length($reqbody) if ($reqbody);
824            }
825            $headers .= "Content-Length: $len\r\n";
826            $headers .= "\r\n";
827    
828            my $sock = IO::Socket::INET->new(
829                    PeerAddr        => $host,
830                    PeerPort        => $port,
831                    Proto           => 'tcp',
832                    Timeout         => $self->{timeout} || 90,
833            );
834    
835            if (! $sock) {
836                    carp "can't open socket to $host:$port";
837                    return -1;
838          }          }
         print $sock "\r\n";  
839    
840          print $sock $$reqbody if ($reqbody);          print $sock $headers or
841                    carp "can't send headers to network:\n$headers\n" and return -1;
842    
843            if ($reqbody) {
844                    print $sock $$reqbody or
845                            carp "can't send request body to network:\n$$reqbody\n" and return -1;
846            }
847    
848          my $line = <$sock>;          my $line = <$sock>;
849          chomp($line);          chomp($line);
# Line 830  sub shuttle_url { Line 853  sub shuttle_url {
853          $self->{status} = $res_status;          $self->{status} = $res_status;
854    
855          # skip rest of headers          # skip rest of headers
856          do {          $line = <$sock>;
857            while ($line) {
858                  $line = <$sock>;                  $line = <$sock>;
859                  chomp($line);                  $line =~ s/[\r\n]+$//;
860          } until ($line eq '');                  warn "## ", $line || 'NULL', " ##\n";
861            };
862    
863          # read body          # read body
864          my $len = 0;          $len = 0;
865          do {          do {
866                  $len = read($sock, my $buf, 8192);                  $len = read($sock, my $buf, 8192);
867                  $$resbody .= $buf if ($resbody);                  $$resbody .= $buf if ($resbody);
Legend:
Removed from v.33  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26