sub
new {
my
$class
=
shift
;
bless
{
base
=>
"darkpan"
,
http
=> HTTP::Tinyish->new(
agent
=>
"CPAN::Mirror::Tiny/$CPAN::Mirror::Tiny::VERSION"
),
},
$class
;
}
sub
run {
shift
->_run(
@_
) ? 0 : 1;
}
sub
_run {
my
$self
=
shift
->new;
$self
->parse_options(
@_
) or
return
;
my
$cmd
=
shift
@{
$self
->{argv}};
if
(!
$cmd
) {
warn
"Missing subcommand, try `$0 --help`\n"
;
return
;
}
(
my
$_cmd
=
$cmd
) =~ s/-/_/g;
if
(
my
$sub
=
$self
->can(
"cmd_$_cmd"
)) {
return
$self
->
$sub
(@{
$self
->{argv}});
}
else
{
warn
"Unknown subcommand '$cmd', try `$0 --help`\n"
;
return
;
}
}
sub
parse_options {
my
$self
=
shift
;
local
@ARGV
=
@_
;
my
$parser
= Getopt::Long::Parser->new(
config
=> [
qw(no_auto_abbrev no_ignore_case pass_through)
],
);
$parser
->getoptions(
"h|help"
=>
sub
{
$self
->cmd_help;
exit
},
"v|version"
=>
sub
{
$self
->cmd_version;
exit
},
"q|quiet"
=> \
$self
->{quiet},
"b|base=s"
=> \
$self
->{base},
"a|author=s"
=> \
$self
->{author},
) or
return
0;
$self
->{argv} = \
@ARGV
;
return
1;
}
sub
cmd_help {
Pod::Usage::pod2usage(0);
return
1;
}
sub
cmd_version {
my
$klass
=
"CPAN::Mirror::Tiny"
;
printf
"%s %s\n"
,
$klass
,
$klass
->VERSION;
}
sub
cmd_inject {
my
(
$self
,
@argv
) =
@_
;
die
"Missing urls, try `$0 --help`\n"
unless
@argv
;
my
$cpan
= CPAN::Mirror::Tiny->new(
base
=>
$self
->{base});
my
$option
=
$self
->{author} ? {
author
=>
$self
->{author} } : +{};
for
my
$argv
(
@argv
) {
print
STDERR
"Injecting $argv"
unless
$self
->{quiet};
if
(
eval
{
$cpan
->inject(
$argv
,
$option
); 1 }) {
print
STDERR
" DONE\n"
unless
$self
->{quiet};
}
else
{
print
STDERR
" FAIL\n"
unless
$self
->{quiet};
die
$@;
}
}
return
1;
}
sub
cmd_gen_index {
my
(
$self
,
@argv
) =
@_
;
my
$cpan
= CPAN::Mirror::Tiny->new(
base
=>
$self
->{base});
print
STDERR
"Generating index for $self->{base}"
unless
$self
->{quiet};
$cpan
->write_index(
compress
=> 1);
print
STDERR
" DONE\n"
unless
$self
->{quiet};
return
1;
}
sub
cmd_cat_index {
my
(
$self
,
@argv
) =
@_
;
my
$index
= File::Spec->catfile(
$self
->{base},
"modules"
,
"02packages.details.txt.gz"
);
return
unless
-f
$index
;
return
!
system
"gunzip"
,
"--stdout"
,
$index
;
}
sub
cmd_list {
my
$self
=
shift
;
return
unless
-d
$self
->{base};
my
(
$index
,
@dist
);
my
$wanted
=
sub
{
my
$name
=
$_
;
return
if
!-f
$name
or
$name
=~ /\.json$/;
my
$mtime
= (
stat
$name
)[9];
if
(
$name
=~ /02packages.details.txt.gz$/) {
$index
= {
name
=>
$name
,
mtime
=>
$mtime
};
}
else
{
push
@dist
, {
name
=>
$name
,
mtime
=>
$mtime
};
}
};
File::Find::find({
wanted
=>
$wanted
,
no_chdir
=> 1},
$self
->{base});
my
$print
=
sub
{
printf
"%s %s\n"
, POSIX::strftime(
"%F %T"
,
localtime
(
$_
[0]->{mtime})),
$_
[0]->{name};
};
$print
->(
$index
)
if
$index
;
for
my
$dist
(
sort
{
$a
->{name} cmp
$b
->{name} }
@dist
) {
$print
->(
$dist
);
}
return
1;
}
sub
cmd_server {
my
$self
=
shift
;
if
($@ =~ m{Can't locate Plack}) {
die
"To run server, you should install Plack first.\n"
;
}
else
{
die
$@;
}
}
CPAN::Mirror::Tiny::Server->start(@{
$self
->{argv}},
$self
->{base});
return
1;
}
1;