vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/local/protosub.t

   1 #!perl
   2
   3 print "1..6\n";
   4
   5 # This test tries to make a custom protocol implementation by
   6 # subclassing of LWP::Protocol.
   7
   8
   9 use LWP::UserAgent ();
  10 use LWP::Protocol ();
  11
  12 LWP::Protocol::implementor(http => 'myhttp');
  13
  14 $ua = LWP::UserAgent->new;
  15 $ua->proxy('ftp' => "http://www.sn.no/");
  16
  17 $req = HTTP::Request->new(GET => 'ftp://foo/');
  18 $req->header(Cookie => "perl=cool");
  19
  20 $res = $ua->request($req);
  21
  22 print $res->as_string;
  23
  24 print "not " unless $res->code == 200;
  25 print "ok 5\n";
  26 print "not " unless $res->content eq "Howdy\n";
  27 print "ok 6\n";
  28 exit;
  29
  30
  31 #----------------------------------
  32 package myhttp;
  33
  34 BEGIN {
  35    @ISA=qw(LWP::Protocol);
  36 }
  37
  38 sub new
  39 {
  40     my $class = shift;
  41     print "CTOR: $class->new(@_)\n";
  42     my($prot) = @_;
  43     print "not " unless $prot eq "http";
  44     print "ok 1\n";
  45     my $self = $class->SUPER::new(@_);
  46     for (keys %$self) {
  47         my $v = $self->{$_};
  48         $v = "<undef>" unless defined($v);
  49         print "$_: $v\n";
  50     }
  51     $self;
  52 }
  53
  54 sub request
  55 {
  56     my $self = shift;
  57     print "REQUEST: $self->request(",
  58        join(",", (map defined($_)? $_ : "UNDEF", @_)), ")\n";
  59
  60     my($request, $proxy, $arg, $size, $timeout) = @_;
  61     print $request->as_string;
  62
  63     print "not " unless $proxy eq "http://www.sn.no/";
  64     print "ok 2\n";
  65     print "not " unless $request->url eq "ftp://foo/";
  66     print "ok 3\n";
  67     print "not " unless $request->header("cookie") eq "perl=cool";
  68     print "ok 4\n";
  69
  70     my $res = HTTP::Response->new(200 => "OK");
  71     $res->content_type("text/plain");
  72     $res->date(time);
  73     $self->collect_once($arg, $res, "Howdy\n");
  74     $res;
  75 }