"Fossies" - the Fresh Open Source Software Archive

Member "libwww-perl-6.43/t/local/httpsub.t" (26 Nov 2019, 1652 Bytes) of package /linux/www/libwww-perl-6.43.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 use strict;
    2 use warnings;
    3 use Test::More;
    4 
    5 use HTTP::Request;
    6 use LWP::UserAgent;
    7 use LWP::Protocol;
    8 use URI;
    9 
   10 plan tests => 2;
   11 
   12 LWP::Protocol::implementor(http => 'myhttp');
   13 
   14 my $ua = LWP::UserAgent->new(keep_alive => 1);
   15 
   16 $ua->proxy('http' => "http://proxy.activestate.com");
   17 my $req = HTTP::Request->new(GET => 'http://gisle:aas@www.activestate.com');
   18 my $res = $ua->request($req);
   19 isa_ok($res, 'HTTP::Response', 'activeState: got a response');
   20 ok($res->as_string, 'activeState: has content');
   21 
   22 exit;
   23 
   24 {
   25     package myhttp;
   26     use base 'LWP::Protocol::http';
   27 
   28     sub _conn_class {
   29         "myconn";
   30     }
   31 }
   32 
   33 {
   34     package myconn;
   35 
   36     sub new {
   37         my $class = shift;
   38         return bless {}, $class;
   39     }
   40 
   41     sub format_request {
   42         my $self = shift;
   43         return "REQ";
   44     }
   45 
   46     sub syswrite {
   47         my $self = shift;
   48         return length($_[0]);
   49     }
   50 
   51     sub read_response_headers {
   52         my $self = shift;
   53         return (302, "OK", "Content-type", "text/plain");
   54     }
   55 
   56     sub read_entity_body {
   57         my $self = shift;
   58         return 0;
   59     }
   60 
   61     sub peer_http_version {
   62         my $self = shift;
   63         return "1.1";
   64     }
   65 
   66     sub increment_response_count {
   67         my $self = shift;
   68         ++$self->{count};
   69     }
   70 
   71     sub get_trailers {
   72         my $self = shift;
   73         return ();
   74     }
   75 }
   76 {
   77     package myhttp::SocketMethods;
   78 
   79     sub ping {
   80         my $self = shift;
   81         !$self->can_read(0);
   82     }
   83 
   84     sub increment_response_count {
   85         my $self = shift;
   86         return ++${*$self}{'myhttp_response_count'};
   87     }
   88 }
   89 {
   90     package myhttp::Socket;
   91     use base qw(myhttp::SocketMethods Net::HTTP);
   92 }