use
5.008_001;
our
$VERSION
=
'0.04'
;
my
$duration
= 2 * 24 * 60 * 60;
sub
opt_spec {
return
(
[
"install|i"
,
"install the module"
],
[
"list|l"
,
"list the recent uploads"
],
[
"help|h"
,
"displays usage info"
],
);
}
sub
execute {
my
(
$self
,
$opt
,
$args
) =
@_
;
if
(
$opt
->{list} &&
$args
->[0]) {
$self
->search(
$args
->[0]);
}
elsif
(
$opt
->{list}) {
$self
->recent;
}
elsif
(
$opt
->{help} || !
@$args
) {
$self
->usage;
}
else
{
$self
->install(
$args
);
}
}
sub
recent {
my
$self
=
shift
;
my
$res
=
$self
->call(
"/feed/cpan"
);
$self
->display_results(
$res
);
}
sub
search {
my
(
$self
,
$q
) =
@_
;
my
$res
=
$self
->call(
"/search"
, {
q
=>
"$q group:cpan"
});
$self
->display_results(
$res
);
}
sub
usage {
Pod::Usage::pod2usage(0);
}
sub
install {
my
(
$self
,
$dists
) =
@_
;
my
@install
;
for
my
$dist
(
@$dists
) {
my
$path
=
$self
->inject(
$dist
);
if
(
$path
) {
push
@install
,
$path
;
}
else
{
print
"$dist is not found or not in the fresh uploads. Falling back to your mirror.\n"
;
push
@install
,
$dist
;
}
}
if
(
@install
) {
CPAN::Shell->install(
@install
);
}
}
sub
inject {
my
(
$self
,
$dist
) =
@_
;
$dist
=~ s/::/-/g;
my
$res
=
$self
->call(
"/search"
, {
q =>
"$dist group:cpan"
});
for
my
$entry
(@{
$res
->{entries}}) {
my
$info
=
$self
->parse_entry(
$entry
->{body},
$entry
->{date}) or
next
;
if
(
$info
->{dist} eq
$dist
) {
return
$self
->do_inject(
$info
);
}
}
return
;
}
sub
do_inject {
my
(
$self
,
$info
) =
@_
;
my
$dir
= File::Temp::tempdir(
CLEANUP
=> 1);
my
$local
=
"$dir/$info->{dist}-$info->{version}.tar.gz"
;
my
$res
=
$self
->new_ua->mirror(
$info
->{url},
$local
);
if
(
$res
->is_error) {
croak
"Fetching $info->{url} failed: "
,
$res
->status_line;
}
CPAN::Inject->from_cpan_config->add(
file
=>
$local
);
}
sub
display_results {
my
(
$self
,
$res
) =
@_
;
for
my
$entry
(@{
$res
->{entries}}) {
my
$info
=
$self
->parse_entry(
$entry
->{body},
$entry
->{date}) or
next
;
printf
"%s-%s (%s)\n"
,
$info
->{dist},
$info
->{version},
$info
->{author};
}
}
sub
parse_entry {
my
(
$self
,
$body
,
$date
) =
@_
;
my
$time
= Time::Piece->strptime(
$date
,
"%Y-%m-%dT%H:%M:%SZ"
) or
return
;
if
(
time
-
$time
->epoch >
$duration
) {
return
;
}
if
(
$body
=~ /^([\w\-]+) ([0-9\._]*) by (.+?) - <a.
*href
=
"(http:.*?\.tar\.gz)"
/) {
return
{
dist
=> $1,
version
=> $2,
author
=> $3,
url
=> $4,
};
}
return
;
}
sub
new_ua {
my
$self
=
shift
;
LWP::UserAgent->new(
agent
=>
"cpanf/$VERSION"
,
env_proxy
=> 1);
}
sub
call {
my
(
$self
,
$method
,
$opts
) =
@_
;
$uri
->query_form(
%$opts
)
if
$opts
;
my
$ua
=
$self
->new_ua;
my
$res
=
$ua
->get(
$uri
);
if
(
$res
->is_error) {
croak
"HTTP error: "
,
$res
->status_line;
}
JSON::decode_json(
$res
->content);
}
1;