Commit | Line | Data |
3fea05b9 |
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->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 | |
52 | 1; |