use
5.008001;
sub
uploader {
my
(
$class
,
%args
) =
@_
;
my
$base
=
$args
{base} or
die
;
my
$tempdir
=
$args
{tempdir} || File::Temp::tempdir(
CLEANUP
=> 1);
my
$compress_index
= 1;
$compress_index
=
$args
{compress_index}
if
exists
$args
{compress_index};
my
$cpan
= CPAN::Mirror::Tiny->new(
base
=>
$base
,
tempdir
=>
$tempdir
);
return
sub
{
my
$env
=
shift
;
my
$req
= Plack::Request->new(
$env
);
return
[404, [], [
'NOT FOUND'
]]
if
$req
->path_info !~ m!\A/?\z!ms;
if
(
$req
->method eq
'POST'
) {
eval
{
my
(
$module
,
$author
);
my
$tempdir
=
$cpan
->tempdir;
if
(
my
$upload
=
$req
->upload(
'pause99_add_uri_httpupload'
)) {
$module
= File::Spec->catfile(
$tempdir
,
$upload
->filename);
File::Copy::move
$upload
->tempname,
$module
;
$author
=
$req
->param(
'HIDDENNAME'
);
}
else
{
$module
=
$req
->param(
'module'
);
$author
=
$req
->param(
'author'
) ||
'VENDOR'
;
}
return
[404, [], [
'NOT FOUND'
]]
if
!
$module
&& !
$author
;
$author
=
uc
$author
;
$cpan
->inject(
$module
, {
author
=>
$author
});
$cpan
->write_index(
compress
=>
$compress_index
);
};
if
(
my
$err
= $@) {
warn
$err
.
''
;
return
[500, [], [
$err
.
''
]];
}
}
else
{
return
[405, [], [
'Method Not Allowed'
]];
}
return
[200, [], [
'OK'
]];
}
}
sub
start {
my
(
$class
,
@argv
) =
@_
;
my
$runner
= Plack::Runner->new;
$runner
->parse_options(
@argv
);
if
(
$runner
->{help}) {
Pod::Usage::pod2usage(0);
}
if
(
$runner
->{version}) {
my
$c
=
"CPAN::Mirror::Tiny"
;
printf
"%s %s\n"
,
$c
,
$c
->VERSION;
exit
;
}
my
$base
=
shift
@{
$runner
->{argv} || []} or
die
"Missing base directory\n"
;
my
$app
= builder {
mount
"/upload"
=>
$class
->uploader(
base
=>
$base
);
mount
"/"
=> Plack::App::Directory->new(
root
=>
$base
)->to_app;
};
$runner
->run(
$app
);
}
1;