]>
jfr.im git - irc/SurrealServices/srsv.git/blob - tags/0.4.3.1-pre2/CPAN/LWP/Protocol/cpan.pm
1 package LWP
::Protocol
::cpan
;
7 @ISA = qw(LWP::Protocol);
11 require HTTP
::Response
;
16 # Try to find local CPAN mirror via $CPAN::Config
20 my $urls = $CPAN::Config-
>{urllist
};
21 if (ref($urls) eq "ARRAY") {
40 $CPAN ||= "http://cpan.org/"; # last resort
43 # ensure that we don't chop of last part
44 $CPAN .= "/" unless $CPAN =~ m
,/$,;
48 my($self, $request, $proxy, $arg, $size) = @_;
52 return HTTP
::Response-
>new(&HTTP
::Status
::RC_BAD_REQUEST
,
53 'You can not proxy with cpan');
57 my $method = $request->method;
58 unless ($method eq 'GET' || $method eq 'HEAD') {
59 return HTTP
::Response-
>new(&HTTP
::Status
::RC_BAD_REQUEST
,
60 'Library does not allow method ' .
61 "$method for 'cpan:' URLs");
64 my $path = $request->uri->path;
67 my $response = HTTP
::Response-
>new(&HTTP
::Status
::RC_FOUND
);
68 $response->header("Location" => URI-
>new_abs($path, $CPAN));