t/local/httpsub.t

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