@ISA
=
qw(LWP::Protocol)
;
our
$CPAN
;
unless
(
$CPAN
) {
eval
{
if
(
$CPAN::Config
) {
my
$urls
=
$CPAN::Config
->{urllist};
if
(
ref
(
$urls
) eq
"ARRAY"
) {
my
$file
;
for
(
@$urls
) {
if
(/^file:/) {
$file
=
$_
;
last
;
}
}
if
(
$file
) {
$CPAN
=
$file
;
}
else
{
$CPAN
=
$urls
->[0];
}
}
}
};
}
$CPAN
.=
"/"
unless
$CPAN
=~ m,/$,;
sub
request {
my
(
$self
,
$request
,
$proxy
,
$arg
,
$size
) =
@_
;
if
(
defined
$proxy
)
{
return
HTTP::Response->new(
&HTTP::Status::RC_BAD_REQUEST
,
'You can not proxy with cpan'
);
}
my
$method
=
$request
->method;
unless
(
$method
eq
'GET'
||
$method
eq
'HEAD'
) {
return
HTTP::Response->new(
&HTTP::Status::RC_BAD_REQUEST
,
'Library does not allow method '
.
"$method for 'cpan:' URLs"
);
}
my
$path
=
$request
->uri->path;
$path
=~ s,^/,,;
my
$response
= HTTP::Response->new(
&HTTP::Status::RC_FOUND
);
$response
->header(
"Location"
=> URI->new_abs(
$path
,
$CPAN
));
$response
;
}
1;