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 HTTP::Response->new( &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 HTTP::Response->new( &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 = HTTP::Response->new( &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 |
|
---|
48 | $data = "" if $method eq "HEAD";
|
---|
49 | return $self->collect_once($arg, $response, $data);
|
---|
50 | }
|
---|
51 |
|
---|
52 | 1;
|
---|