#!/usr/bin/env perl
our
$VERSION
=
'0.04'
;
my
(
$help
,
$man
);
my
$verbose
= 0;
my
%options
;
GetOptions(
'help|?'
=> \
$help
,
'man'
=> \
$man
,
'verbose+'
=> \
$verbose
,
'remote_server=s'
=> \
$options
{remote_server},
'add'
=> \(
$options
{action}->{add}),
'module=s'
=> \(
$options
{add}->{module}),
'authorid=s'
=> \(
$options
{add}->{authorid}),
'modversion=s'
=> \(
$options
{add}->{version}),
'file=s'
=> \(
$options
{add}->{file}),
'update'
=> \(
$options
{action}->{update}),
'inject'
=> \(
$options
{action}->{inject}),
) or pod2usage(2);
pod2usage(1)
if
$help
;
pod2usage(
-exitstatus
=> 0,
-verbose
=> 2)
if
$man
;
sub
get_name_version {
my
$file
=
shift
;
(
my
$tar
= Archive::Tar->new) or
die
"can't new Archive::Tar"
;
if
(
$tar
->
read
(
$file
, {
filter
=>
qr/META/
}))
{
my
@list
=
$tar
->list_files([
qw(name)
]);
for
(
grep
/META/,
@list
)
{
next
unless
my
$string
=
$tar
->get_content(
$_
);
print
$string
if
$verbose
> 1;
next
unless
my
$meta
= CPAN::Meta->load_string(
$string
);
(
my
$scan_version
=
$meta
->version) .=
'(?:_\d+)?'
;
my
(
$modversion
) =
$file
=~ /(
$scan_version
)/;
(
my
$scan_name
=
$meta
->name) =~ s{-}{[/-]}g;
my
(
$modname
) =
map
{ /\b(
$scan_name
)(\.\w+)?$/? $1 : () }
@list
;
$modname
=~ s/\//::/g;
return
(
$modname
,
$modversion
)
if
$modname
&&
$modversion
;
}
}
}
if
(not (
grep
$options
{action}->{
$_
},
qw/add update inject/
)
and not
$options
{add}->{module}
and not
$options
{add}->{version}
and not
$options
{add}->{file})
{
my
$inject
;
for
(
@ARGV
)
{
if
(
my
(
$modname
,
$modversion
) = get_name_version(
$_
))
{
$options
{add}->{authorid} or
warn
"$0: authorid DUMMY\n"
;
my
@mcpani
= (
$0,
'-add'
,
'-file'
,
$_
,
'-module'
,
$modname
,
'-modversion'
,
$modversion
,
'-author'
,
$options
{add}->{authorid} ||
'DUMMY'
,
);
warn
"@mcpani\n"
if
$verbose
;
exit
1
unless
(
system
@mcpani
) == 0;
$inject
++;
}
}
$options
{action}->{inject} =
$inject
;
}
if
(not (
$options
{action}->{add}
or
$options
{action}->{update}
or
$options
{action}->{inject}))
{
pod2usage(
'An action must be supplied'
);
}
if
(
$options
{action}->{add}
and not
$options
{add}->{module})
{
pod2usage(
'A module name must be supplied for adding'
);
}
if
(
$options
{action}->{add}
and not
$options
{add}->{authorid})
{
pod2usage(
'An authorid must be supplied for adding'
);
}
if
(
$options
{action}->{add}
and not
$options
{add}->{version})
{
pod2usage(
'A module version must be supplied for adding'
);
}
if
(
$options
{action}->{add}
and not
$options
{add}->{file})
{
pod2usage(
'A module file must be supplied for adding'
);
}
my
$cpan_mini
= CPAN::Mini::Inject::Remote->new(
(
$options
{remote_server}
? (
remote_server
=>
$options
{remote_server})
: ()
)
);
if
(
$options
{action}->{add})
{
exit
1
unless
$cpan_mini
->add(
module_name
=>
$options
{add}->{module},
author_id
=>
$options
{add}->{authorid},
version
=>
$options
{add}->{version},
file_name
=>
$options
{add}->{file},
)->is_success();
}
if
(
$options
{action}->{inject})
{
exit
1
unless
$cpan_mini
->inject()->is_success();
}
if
(
$options
{action}->{update})
{
exit
1
unless
$cpan_mini
->update()->is_success();
}