git.maemo.org Git - dh-make-perl/blob - dev/i386/libwww-perl/libwww-perl-5.813/lib/LWP/Protocol/loopback.pm

   1 package LWP::Protocol::loopback;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 require HTTP::Response;
   6
   7 require LWP::Protocol;
   8 @ISA = qw(LWP::Protocol);
   9
  10 sub request {
  11     my($self, $request, $proxy, $arg, $size, $timeout) = @_;
  12
  13     my $response = HTTP::Response->new(200, "OK");
  14     $response->content_type("message/http; msgtype=request");
  15
  16     $response->header("Via", "loopback/1.0 $proxy")
  17         if $proxy;
  18
  19     $response->header("X-Arg", $arg);
  20     $response->header("X-Read-Size", $size);
  21     $response->header("X-Timeout", $timeout);
  22
  23     return $self->collect_once($arg, $response, $request->as_string);
  24 }
  25
  26 1;