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

   1 package LWP::Protocol::data;
   2
   3 # Implements access to data:-URLs as specified in RFC 2397
   4
   5 use strict;
   6 use vars qw(@ISA);
   7
   8 require HTTP::Response;
   9 require HTTP::Status;
  10
  11 require LWP::Protocol;
  12 @ISA = qw(LWP::Protocol);
  13
  14 use HTTP::Date qw(time2str);
  15 require LWP;  # needs version number
  16
  17 sub request
  18 {
  19     my($self, $request, $proxy, $arg, $size) = @_;
  20
  21     # check proxy
  22     if (defined $proxy)
  23     {
  24         return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  25                                   'You can not proxy with data';
  26     }
  27
  28     # check method
  29     my $method = $request->method;
  30     unless ($method eq 'GET' || $method eq 'HEAD') {
  31         return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  32                                   'Library does not allow method ' .
  33                                   "$method for 'data:' URLs";
  34     }
  35
  36     my $url = $request->url;
  37     my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
  38
  39     my $media_type = $url->media_type;
  40
  41     my $data = $url->data;
  42     $response->header('Content-Type'   => $media_type,
  43                       'Content-Length' => length($data),
  44                       'Date'           => time2str(time),
  45                       'Server'         => "libwww-perl-internal/$LWP::VERSION"
  46                      );
  47     $response->content($data) if $method ne "HEAD";
  48
  49     return $response;
  50 }
  51
  52 1;