# The fetch() routine retrieves the contents of any URL # Quick & dirty http client sub fetch { my ($url,$content,$content_type) = @_; $content_type ||= 'application/octet-stream' if $content; # parse out the URL in a simple fashion my ($nethost,$request) = $url =~ m!^http://([^/]+)(.*)!; $nethost .= ':80' unless $nethost=~/:\d+$/; $request ||= '/'; # try to make connection with remote host IO::Socket->input_record_separator("\r\n\r\n"); my $h = IO::Socket::INET->new($nethost); return (503,'Connection refused') unless $h; # send the request if ($content) { $h->print ("POST $request HTTP/1.0\r\n"); $h->print ("Content-type: $content_type\r\n"); $h->print ("Content-length: ",length($content),"\r\n\r\n"); $h->print ($content); } else { $h->print ("GET $request HTTP/1.0\r\n\r\n"); } # read the header $header = $h->getline; my ($status_line,%fields) = split(/^([-\w]+):/m,$header); my ($status,$message) = $status_line =~ m!http/1\.\d+\s+(\d+)\s+(.*)$!i; return (400,"malformed header") unless $status; # read the document body, if any my ($data,$doc_body); do { $doc_body .= $data } while $h->read($data,1024); $h->close; return ($status,$message,$doc_body); }