/[Search-Estraier]/trunk/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/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 36 by dpavlin, Thu Jan 5 21:51:54 2006 UTC revision 39 by dpavlin, Thu Jan 5 22:36:10 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 MIME::Base64;  use MIME::Base64;
667  use IO::Socket::INET;  use IO::Socket::INET;
# Line 689  sub new { Line 689  sub new {
689          };          };
690          bless($self, $class);          bless($self, $class);
691    
692            if (@_) {
693                    $self->{debug} = 1;
694                    warn "## Node debug on\n";
695            }
696    
697          $self ? return $self : return undef;          $self ? return $self : return undef;
698  }  }
699    
# Line 784  sub shuttle_url { Line 789  sub shuttle_url {
789    
790          my $status = -1;          my $status = -1;
791    
792          warn $url;          warn "## $url\n";
793    
794          $url = new URI($url);          $url = new URI($url);
795          return -1 unless ($url && $url->scheme && $url->scheme eq 'http' && $url->host && $url->port > 1);          if (
796                            !$url || !$url->scheme || !$url->scheme eq 'http' ||
797                            !$url->host || !$url->port || $url->port < 1
798                    ) {
799                    carp "can't parse $url\n";
800                    return -1;
801            }
802    
803          my ($host,$port,$query) = ($url->host, $url->port, $url->path);          my ($host,$port,$query) = ($url->host, $url->port, $url->path);
804    
# Line 796  sub shuttle_url { Line 807  sub shuttle_url {
807                  $query = "http://$host:$port/$query";                  $query = "http://$host:$port/$query";
808          }          }
809    
810          $query .= '?' + $url->query if ($url->query && ! $reqbody);          $query .= '?' . $url->query if ($url->query && ! $reqbody);
811    
812          my $sock = IO::Socket::INET->new(          my $headers;
                 PeerAddr        => $host,  
                 PeerPort        => $port,  
                 Proto           => 'tcp',  
                 Timeout         => $self->{timeout} || 90,  
         ) || return -1;  
813    
814          if ($reqbody) {          if ($reqbody) {
815                  print $sock "POST $query HTTP/1.0\r\n";                  $headers .= "POST $query HTTP/1.0\r\n";
816          } else {          } else {
817                  print $sock "GET $query HTTP/1.0\r\n";                  $headers .= "GET $query HTTP/1.0\r\n";
818          }          }
819    
820          print $sock "Host: $url->host:$url->port\r\n";          $headers .= "Host: $url->host:$url->port\r\n";
821          print $sock "Connection: close\r\n";          $headers .= "Connection: close\r\n";
822          print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";          $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
823          print $sock "Content-Type $content_type\r\n";          $headers .= "Content-Type $content_type\r\n";
824          print $sock "Authorization: Basic $self->{auth}\r\n";          $headers .= "Authorization: Basic $self->{auth}\r\n";
825            my $len = 0;
826          {          {
827                  use bytes;                  use bytes;
828                  print $sock "Content-Length: ", length($reqbody), "\r\n";                  $len = length($reqbody) if ($reqbody);
829          }          }
830          print $sock "\r\n";          $headers .= "Content-Length: $len\r\n";
831            $headers .= "\r\n";
832    
833          print $sock $$reqbody if ($reqbody);          my $sock = IO::Socket::INET->new(
834                    PeerAddr        => $host,
835                    PeerPort        => $port,
836                    Proto           => 'tcp',
837                    Timeout         => $self->{timeout} || 90,
838            );
839    
840            if (! $sock) {
841                    carp "can't open socket to $host:$port";
842                    return -1;
843            }
844    
845            warn "## headers:\n$headers\n" if ($self->{debug});
846    
847            print $sock $headers or
848                    carp "can't send headers to network:\n$headers\n" and return -1;
849    
850            if ($reqbody) {
851                    warn "## request body:\n$headers\n" if ($self->{debug});
852                    print $sock $$reqbody or
853                            carp "can't send request body to network:\n$$reqbody\n" and return -1;
854            }
855    
856          my $line = <$sock>;          my $line = <$sock>;
857          chomp($line);          chomp($line);
858          my ($schema, $res_status, undef) = split(/  */, $line, 3);          my ($schema, $res_status, undef) = split(/  */, $line, 3);
859          return if ($schema !~ /^HTTP/ || ! $res_status);          return if ($schema !~ /^HTTP/ || ! $res_status);
860    
861          $self->{status} = $res_status;          $status = $res_status;
862            warn "## response status: $res_status\n" if ($self->{debug});
863    
864          # skip rest of headers          # skip rest of headers
865          do {          $line = <$sock>;
866            while ($line) {
867                  $line = <$sock>;                  $line = <$sock>;
868                  chomp($line);                  $line =~ s/[\r\n]+$//;
869          } until ($line eq '');                  warn "## ", $line || 'NULL', " ##\n";
870            };
871    
872          # read body          # read body
873          my $len = 0;          $len = 0;
874          do {          do {
875                  $len = read($sock, my $buf, 8192);                  $len = read($sock, my $buf, 8192);
876                  $$resbody .= $buf if ($resbody);                  $$resbody .= $buf if ($resbody);
877          } while ($len);          } while ($len);
878    
879            
880            warn "## response body:\n$$resbody\n" if ($self->{debug});
881    
882          return $status;          return $status;
883  }  }
884    
Legend:
Removed from v.36  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.26