Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / LWP / Protocol / data.pm
CommitLineData
3fea05b9 1package LWP::Protocol::data;
2
3# Implements access to data:-URLs as specified in RFC 2397
4
5use strict;
6use vars qw(@ISA);
7
8require HTTP::Response;
9require HTTP::Status;
10
11require LWP::Protocol;
12@ISA = qw(LWP::Protocol);
13
14use HTTP::Date qw(time2str);
15require LWP; # needs version number
16
17sub 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->uri;
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
521;