#!/bin/env perl
use
JSON
qw( encode_json decode_json )
;
our
$VERSION
=
'1.5.41'
;
caller
or __PACKAGE__->main();
sub
help {
my
(
$options
) =
@_
;
my
$token
;
if
(
$options
->{pager} ) {
$token
=
eval
{
IO::Pager::
open
(
*STDOUT
,
'|-:utf8'
,
'Unbuffered'
);
};
}
my
$file
= pod_where( {
-inc
=>
$TRUE
},
'CPAN::Maker'
);
return
pod2usage( {
-input
=>
$file
,
-exitval
=> 1,
-verbose
=> 1 } );
}
sub
_is_obj {
my
(
$this
,
$type
) =
@_
;
return
ref
$this
&& reftype(
$this
) eq
$type
;
}
sub
is_array {
my
(
$this
) =
@_
;
return
_is_obj(
$this
,
'ARRAY'
);
}
sub
is_scalar {
my
(
$this
) =
@_
;
return
!
ref
$this
;
}
sub
is_hash {
my
(
$this
) =
@_
;
return
_is_obj(
$this
,
'HASH'
);
}
sub
get_exe_file_list {
my
(
$file
) =
@_
;
my
$lines
;
if
(
$file
) {
(
$lines
) = process_file(
$file
,
chomp
=>
$TRUE
,
skip_blank_lines
=>
$TRUE
,
process
=>
sub
{
my
$f
=
pop
@_
;
$f
=~ s/^.*\/(.*)$/bin\/$1/xsm;
return
$f
;
}
);
}
return
$lines
? @{
$lines
} : ();
}
sub
get_perl_version {
my
(
$requires
) =
@_
;
my
$version
;
if
( !-e
$requires
) {
return
;
}
process_file(
$requires
,
chomp
=>
$TRUE
,
process
=>
sub
{
my
$module
=
pop
@_
;
if
(
$module
!~ /^perl\s+/xsm ) {
return
();
}
(
undef
,
$version
) =
split
/\s+/xsm,
$module
;
return
;
}
);
return
$version
;
}
sub
get_provides {
my
(
$file
,
%options
) =
@_
;
my
%provides
;
if
(
$file
) {
my
(
$lines
) = process_file(
$file
,
chomp
=>
$TRUE
,
skip_blank_lines
=>
$TRUE
,
prefix
=>
'lib'
,
process
=>
sub
{
my
$module
=
pop
@_
;
my
$args
=
pop
@_
;
if
( !
$module
) {
return
();
}
my
$include_path
=
$args
->{
'prefix'
};
if
(
$options
{
'work-dir'
} ) {
$include_path
=
$options
{
'work-dir'
} .
$SLASH
.
$include_path
;
}
my
$module_version
= get_module_version(
$module
,
$include_path
);
my
(
$provided_module
,
$version
)
= @{
$module_version
}{
qw( module version)
};
croak
"$module not found in $include_path"
if
!
defined
$version
;
$provides
{
$provided_module
} = {
file
=>
$args
->{prefix} .
$SLASH
.
$module_version
->{
'file'
},
version
=>
$version
,
};
return
$provided_module
;
}
);
}
return
%provides
;
}
sub
get_resources {
goto
&get_json_file
;
}
sub
get_json_file {
my
(
$file
) =
@_
;
my
(
$json
) = process_file(
$file
,
chomp
=> 1,
merge_lines
=> 1
);
return
decode_json(
$json
);
}
sub
write_resources {
my
(
$resources
,
%args
) =
@_
;
my
$resources_file
;
if
(
$resources
) {
$resources_file
=
'resources'
;
open
my
$fh
,
'>'
,
$resources_file
or croak
"could not open resources for writing\n"
;
print
{
$fh
} JSON->new->pretty->encode(
$resources
);
close
$fh
or croak
"could not close file $resources_file\n"
;
}
return
%args
;
}
sub
write_pl_files {
my
(
$pl_files
,
%args
) =
@_
;
return
%args
if
!
$pl_files
;
my
(
$fh
,
$filename
) = tempfile(
'make-cpan-dist-XXXXX'
,
TMPDIR
=>
$TRUE
);
print
{
$fh
}
join
$SPACE
, %{
$pl_files
};
close
$fh
;
$args
{y} =
$filename
;
return
%args
;
}
sub
write_provides {
my
(
$provides
,
%args
) =
@_
;
return
%args
if
!
$provides
;
my
$provides_file
=
'provides'
;
open
my
$fh
,
'>'
,
$provides_file
or croak
"could not open 'provides' for writing\n"
;
foreach
my
$file
(
sort
@{
$provides
} ) {
next
if
!
$file
;
print
{
$fh
}
"$file\n"
;
}
close
$fh
or croak
"could not close 'provides'\n"
;
$args
{P} =
$provides_file
;
return
%args
;
}
sub
write_makefile {
my
(
%options
) =
@_
;
my
$core
=
$options
{
'core-modules'
};
my
$MODULE_ABSTRACT
=
$options
{abstract};
my
$AUTHOR
=
$options
{author};
my
$project_root
=
$options
{
'project-root'
};
my
$email
;
my
$author
;
if
(
$AUTHOR
&&
$AUTHOR
=~ /^([^<]+)\s+<([^>]+)>\s*$/xsm ) {
$author
= $1;
$email
= $2;
}
my
$PM_MODULE
=
$options
{module};
my
%buildspec
= (
version
=>
$VERSION
,
project
=> {
description
=>
$MODULE_ABSTRACT
,
author
=> {
name
=>
$AUTHOR
//
'Anonymouse'
,
mailto
=>
$email
//
'anonymouse@example.org'
,
},
},
pm_module
=>
$PM_MODULE
,
);
my
$VERSION_FROM
=
$options
{
'version-from'
} //
$options
{module};
if
(
$VERSION_FROM
!~ /\//xsm ) {
$VERSION_FROM
=
'lib/'
. make_path_from_module(
$VERSION_FROM
);
}
$buildspec
{
'version-from'
} =
$VERSION_FROM
;
local
$Data::Dumper::Terse
=
$TRUE
;
local
$Data::Dumper::Sortkeys
=
$TRUE
;
local
$Data::Dumper::Indent
= 2;
local
$Data::Dumper::Pad
=
$SPACE
x
$INDENT
;
foreach
my
$d
(
qw(requires test-requires build-requires )
) {
$options
{
$d
} =
$options
{
$d
} ||
$d
;
}
$buildspec
{dependencies} = {
$options
{requires} ? (
requires
=>
$options
{requires} ) : (),
$options
{test_requires} ? (
test_requires
=>
$options
{
'test-requires'
} ) : (),
$options
{build_requires} ? (
build_requires
=>
$options
{
'build-requires'
} ) : (),
};
foreach
(
qw(requires test_requires build_requires)
) {
next
if
!
$buildspec
{dependencies}->{
$_
};
$buildspec
{dependencies}->{
$_
} =~ s/
$project_root
\/?//xsm;
}
my
$PRE_REQ
= Dumper get_requires(
$options
{
'requires'
},
$core
,
$options
{
'min-perl-version'
} );
$PRE_REQ
= trim(
$PRE_REQ
);
$PRE_REQ
=~ s/([@]\d+)/== $2/xsmg;
my
$TEST_REQ
= {};
if
(
$options
{
'test-requires'
} && -s
$options
{
'test-requires'
} ) {
$TEST_REQ
= Dumper get_requires(
$options
{
'test-requires'
},
$core
,
$options
{
'min-perl-version'
} );
}
else
{
$TEST_REQ
=
'{}'
;
}
$TEST_REQ
= trim(
$TEST_REQ
);
$TEST_REQ
=~ s/\@(\d+)/== $1/xsmg;
my
$build_req
= {};
if
(
$options
{
'build-requires'
} && -s
$options
{
'build-requires'
} ) {
$build_req
= get_requires(
$options
{
'build-requires'
},
$TRUE
,
$options
{
'min-perl-version'
} );
}
foreach
my
$m
(
qw( ExtUtils::MakeMaker File::ShareDir::Install)
) {
$build_req
->{
$m
} =
$build_req
->{
$m
} ||
$FALSE
;
}
$build_req
= Dumper
$build_req
;
my
@exe_file_list
;
$buildspec
{path} = {
pm_module
=>
$options
{
'module-path'
},
recurse
=>
$options
{recurse} ?
'yes'
:
'no'
,
};
my
$exe_files
=
$options
{
'exe-files'
} ||
$options
{
'exec-path'
};
if
(
$exe_files
&& -s
$exe_files
) {
@exe_file_list
= get_exe_file_list(
$exe_files
);
$options
{
'exec-path'
} =
$exe_files
;
}
foreach
my
$p
( pairs
qw(exe-files exec-path scripts scripts-path tests tests-path)
) {
next
if
!
$options
{
$p
->[1] };
my
$project_file
=
sprintf
'%s/%s'
,
$project_root
,
$options
{
$p
->[1] };
if
( -e
$project_file
) {
$buildspec
{path}->{
$p
->[0] } =
$options
{
$p
->[1] };
}
else
{
$buildspec
{
$p
->[0] } = fetch_relative_filelist(
$project_root
,
$options
{
$p
->[1] } );
if
(
$options
{
$p
->[1] } =~ /make\-cpan\-dist\-[[:alpha:]]{5}/xsm ) {
unlink
$options
{
$p
->[1] };
}
}
}
if
(
$options
{
'extra-path'
} ) {
$buildspec
{
'extra-files'
} =
$options
{
'extra-path'
};
}
my
$EXE_FILES
= Dumper \
@exe_file_list
;
my
%provides
;
if
( -e
'provides'
) {
%provides
= get_provides(
'provides'
,
%options
);
$buildspec
{provides} = [
keys
%provides
];
}
my
$resources_path
=
$options
{resources} //
'resources'
;
my
$resources
;
if
( -e
$resources_path
) {
$resources
= get_resources(
$resources_path
);
$buildspec
{resources} =
$resources
;
}
my
$META_MERGE
=
'META_MERGE '
.
$FAT_ARROW
;
{
local
$Data::Dumper::Pair
=
$FAT_ARROW
;
$META_MERGE
.= Dumper(
{
'meta-spec'
=> {
version
=> 2 },
'provides'
=> \
%provides
,
$resources
? (
'resources'
=>
$resources
) : ()
}
);
}
my
$timestamp
=
scalar
localtime
;
my
$MIN_PERL_VERSION
=
$options
{
'min-perl-version'
} //
$PERL_VERSION
;
$buildspec
{
'min-perl-version'
} =
$MIN_PERL_VERSION
;
my
%pl_list
;
my
$pl_files
=
$options
{
'pl-files'
};
if
(
$pl_files
&& -s
$pl_files
) {
my
@file_list
=
split
/\n/xsm, slurp_file(
$pl_files
);
foreach
my
$pl_file
(
@file_list
) {
my
(
$file
,
$target
) =
split
/\s+/xsm,
$_
;
$pl_list
{
$file
} =
$target
;
}
$buildspec
{
'pl-files'
} = \
%pl_list
;
}
my
$PL_FILES
= Dumper( \
%pl_list
);
$buildspec
{postamble} =
$options
{postamble};
my
$MAKEFILE
=
<<"END_OF_TEXT";
# autogenerated by $PROGRAM_NAME on $timestamp
use strict;
use warnings;
use ExtUtils::MakeMaker;
use File::ShareDir::Install;
if ( -d 'share' ) {
install_share 'share';
}
WriteMakefile(
NAME => '$PM_MODULE',
MIN_PERL_VERSION => '$MIN_PERL_VERSION',
AUTHOR => '$AUTHOR',
VERSION_FROM => '$VERSION_FROM',
ABSTRACT => '$MODULE_ABSTRACT',
LICENSE => 'perl',
PL_FILES => $PL_FILES,
EXE_FILES => $EXE_FILES,
PREREQ_PM => $PRE_REQ,
BUILD_REQUIRES => {
'ExtUtils::MakeMaker' => '6.64',
'File::ShareDir::Install' => $NO_VERSION,
},
CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => '6.64',
'File::ShareDir::Install' => $NO_VERSION,
},
TEST_REQUIRES => $TEST_REQ,
$META_MERGE
);
END_OF_TEXT
$MAKEFILE
.=
<<'END_OF_MAKEFILE';
package MY;
use File::ShareDir::Install;
use English qw(-no_match_vars);
sub postamble {
my $self = shift;
my @ret = File::ShareDir::Install::postamble($self);
my $postamble = join "\n", @ret;
if ( -e 'postamble' ) {
local $RS = undef;
open my $fh, '<', 'postamble'
or die "could not open postamble\n";
$postamble .= <$fh>;
close $fh;
}
return $postamble;
}
1;
END_OF_MAKEFILE
print
$MAKEFILE
;
DEBUG
sub
{
return
$MAKEFILE
};
write_buildspec_file( \
%buildspec
, \
%options
);
return
$SUCCESS
;
}
sub
write_buildspec_file {
my
(
$buildspec
,
$options
) =
@_
;
my
(
$buildspec_file
,
$overwrite
) = @{
$options
}{
qw(create-buildspec overwrite)
};
return
if
!
$buildspec_file
;
die
"$buildspec_file exists\n"
if
-e
$buildspec_file
&& !
$overwrite
;
open
my
$fh
,
'>'
,
$buildspec_file
or
die
"could not open $buildspec_file for writing\n"
;
print
{
$fh
} Dump(
$buildspec
);
close
$fh
;
return
;
}
sub
fetch_file_list {
my
(
%args
) =
@_
;
my
(
$file_list
,
$destdir
,
$project_root
) =
@args
{
qw(file_list destination project_root exclude)
};
my
@expanded_list
;
my
@exclude
=
grep
{/^!/xsm} @{
$file_list
};
foreach
(
@exclude
) {
s/^!//xsm;
}
foreach
my
$f
(
grep
{ !/^!/xsm } @{
$file_list
} ) {
my
$fqp
=
sprintf
'%s/%s'
,
$project_root
,
$f
;
DEBUG Dumper( [
'fetch_file_list:'
,
$fqp
] );
my
$cwd
= cwd();
if
( -d
$fqp
) {
eval
{
find(
{
follow
=>
$TRUE
,
wanted
=>
sub
{
return
if
/^[.]/xsm || -d
$_
;
die
'done'
if
cwd() ne
$fqp
;
my
$name
=
$_
;
foreach
my
$e
(
@exclude
) {
if
(
$e
=~ /^\/([^\/]+)\/$/xsm ) {
my
$pat
=
qr/$1/
xsm;
if
(
$name
=~ /
$pat
/ ) {
return
;
}
}
return
if
$e
eq
$name
;
}
push
@expanded_list
,
"$File::Find::name $destdir/$name"
;
}
},
$fqp
);
};
chdir
$cwd
;
for
(
@expanded_list
) {
s/^
$project_root
//xsm;
}
}
else
{
die
"ERROR: missing file in list ($fqp) - check your `extra-files` section\n"
if
!-e
$fqp
;
my
(
$name
,
$path
,
$ext
) = fileparse(
$fqp
,
qr/[.][^.]+/
xsm );
push
@expanded_list
,
sprintf
'%s %s/%s%s'
,
$f
,
$destdir
,
$name
,
$ext
;
}
}
return
@expanded_list
;
}
sub
write_extra_files {
my
(
%params
) =
@_
;
DEBUG(
'writing extra-files'
);
my
(
$extra_files
,
$extra
,
$project_root
) =
@params
{
qw(extra_files extra project_root)
};
my
%args
= %{
$params
{args} };
$extra_files
//= [];
croak
"extra-files must be an array!\n"
. Dumper( [
$extra_files
, \
%params
] )
if
!is_array(
$extra_files
);
my
$extra_files_path
=
$extra
||
'extra-files'
;
my
@file_list
;
foreach
my
$e
( @{
$extra_files
} ) {
DEBUG Dumper( [
extra
=>
$e
] );
if
( !
ref
$e
) {
push
@file_list
,
fetch_file_list(
file_list
=> [
$e
],
destination
=>
$EMPTY
,
project_root
=>
$project_root
,
);
}
elsif
( is_hash(
$e
) ) {
my
(
$destdir
) =
keys
%{
$e
};
my
$file_list
=
$e
->{
$destdir
};
croak
'directory args for extra-files must be an array!'
if
!is_array(
$file_list
);
push
@file_list
,
fetch_file_list(
file_list
=>
$file_list
,
destination
=>
$destdir
,
project_root
=>
$project_root
,
);
}
}
if
(
@file_list
) {
open
my
$fh
,
'>'
,
$extra_files_path
or croak
"could not append to $extra_files_path\n"
;
foreach
my
$f
(
@file_list
) {
print
{
$fh
}
"$f\n"
;
}
close
$fh
or croak
"could not close $extra_files_path\n"
;
}
$args
{f} =
$extra_files_path
;
return
%args
;
}
sub
parse_path {
my
(
$project_root
,
$path
,
%args
) =
@_
;
if
(
$path
) {
if
(
$path
->{
'recurse'
}
&&
$path
->{
'recurse'
} =~ /(yes|
no
)/ixsm ) {
$args
{R} =
$path
->{
'recurse'
};
}
elsif
(
$path
->{
'recurse'
} ) {
croak
"use only yes or no for 'recurse' option\n"
;
}
if
(
$path
->{
'pm_module'
} ) {
$args
{l} =
$path
->{
'pm_module'
};
}
if
(
$path
->{exe_files} ) {
check_path(
$project_root
,
$path
->{exe_files},
'exe_files'
);
$args
{e} =
$path
->{exe_files};
}
if
(
$path
->{scripts} ) {
check_path(
$project_root
,
$path
->{scripts},
'scripts'
);
$args
{S} =
$path
->{scripts};
}
if
(
$path
->{tests} ) {
check_path(
$project_root
,
$path
->{tests},
'tests'
);
$args
{t} =
$path
->{tests};
}
}
return
%args
;
}
sub
check_path {
my
(
$project_root
,
$path
,
$option_name
) =
@_
;
die
sprintf
"ERROR: '%s' must be a scalar representing a path not %s\n"
,
$option_name
, reftype(
$path
)
if
ref
$path
;
my
$exists
=
$path
=~ /^\//xsm ? -d
$path
: -d
"$project_root/$path"
;
die
"no such path: [$path] - must be absolute or relative to $project_root\n"
if
!
$exists
;
return
$TRUE
;
}
sub
parse_dependencies {
my
(
$dependencies
,
%args
) =
@_
;
if
(
$dependencies
) {
croak
'malformed buildspec.yml file - dependencies section with no keys?'
if
!
keys
%{
$dependencies
};
$dependencies
->{core_modules} //=
'no'
;
$dependencies
->{required_modules} //=
'yes'
;
if
(
$dependencies
->{path} ) {
$args
{D} =
$dependencies
->{path};
warn
"path is deprecated: use requires\n"
;
}
if
(
$dependencies
->{requires} ) {
$args
{D} =
$dependencies
->{requires};
}
if
(
$dependencies
->{test_requires} ) {
$args
{T} =
$dependencies
->{test_requires};
}
if
(
$dependencies
->{build_requires} ) {
$args
{B} =
$dependencies
->{build_requires};
}
if
(
$dependencies
->{core_modules} eq
'yes'
) {
$args
{c} =
$EMPTY
;
}
if
(
$dependencies
->{required_modules} eq
'no'
) {
$args
{n} =
$EMPTY
;
}
if
(
my
$resolver
=
$dependencies
->{resolver} ) {
if
(
$resolver
eq
'scandeps'
) {
$args
{s} =
$EMPTY
;
}
else
{
$args
{r} =
$dependencies
->{resolver};
}
}
if
(
$args
{D} &&
$args
{r} ) {
croak
"use either path or resolver for dependencies, but not both\n"
;
}
}
return
%args
;
}
sub
parse_include_version {
my
(
$version
,
%args
) =
@_
;
if
(
defined
$version
) {
if
(
$version
=~ /(
no
|0|off)/xsm ) {
$args
{A} =
$EMPTY
;
}
}
return
%args
;
}
sub
parse_project {
my
(
$project
,
%args
) =
@_
;
if
(
$project
) {
if
(
$project
->{author} ) {
$args
{a} =
$project
->{author}->{name};
if
(
$project
->{author}->{mailto} ) {
$args
{a} .=
' <'
.
$project
->{author}->{mailto} .
'>'
;
}
$args
{a} =
sprintf
q{'%s'}
,
$args
{a};
}
if
(
$project
->{description} ) {
$args
{d} =
sprintf
q{'%s'}
,
$project
->{description};
}
if
(
$project
->{git} ) {
$args
{g} =
$project
->{git};
}
}
return
%args
;
}
sub
parse_pm_module {
my
(
$pm_module
,
%args
) =
@_
;
if
(
$pm_module
) {
$args
{m} =
$pm_module
;
}
return
%args
;
}
sub
get_buildspec {
my
(
$file
) =
@_
;
croak
'file not found or empty '
.
$file
.
$NL
if
!-s
$file
;
my
$buildspec
=
eval
{ YAML::Tiny->
read
(
$file
)->[0]; };
croak
'could not read '
.
$file
.
$NL
.
$EVAL_ERROR
.
$NL
if
$EVAL_ERROR
|| !
$buildspec
;
$buildspec
->{min_perl_version} =
$buildspec
->{
'min-perl-version'
};
$buildspec
->{include_version} =
$buildspec
->{
'include-version'
};
return
$buildspec
;
}
sub
parse_buildspec {
my
(
%options
) =
@_
;
my
$file
=
$options
{buildspec};
my
$buildspec
= get_buildspec(
$file
);
my
$project_root
=
$options
{
'project-root'
};
croak
'bad build file'
if
!validate_object(
$buildspec
,
$options
{
'yaml-spec'
} );
my
%args
;
if
(
$buildspec
->{min_perl_version} ) {
$args
{M} =
$buildspec
->{min_perl_version};
}
if
(
$buildspec
->{
'version_from'
} ||
$buildspec
->{
'version-from'
} ) {
$args
{V} =
$buildspec
->{version_from} //
$buildspec
->{
'version-from'
};
}
if
(
$options
{
'project-root'
} ) {
$args
{H} =
$options
{
'project-root'
};
}
if
(
$options
{postamble} ) {
$args
{F} =
$options
{postamble};
}
if
(
$buildspec
->{exe_files} ) {
$args
{e} = create_temp_filelist(
$project_root
,
$buildspec
->{exe_files} );
}
if
(
$buildspec
->{tests} ) {
$args
{t} = create_temp_filelist(
$project_root
,
$buildspec
->{tests} );
}
if
(
$buildspec
->{scripts} ) {
$args
{S} = create_temp_filelist(
$project_root
,
$buildspec
->{scripts} );
}
%args
= write_resources(
$buildspec
->{resources},
%args
);
%args
= parse_project(
$buildspec
->{project},
%args
);
%args
= parse_pm_module(
$buildspec
->{pm_module},
%args
);
%args
= parse_include_version(
$buildspec
->{include_version},
%args
);
%args
= parse_dependencies(
$buildspec
->{dependencies},
%args
);
%args
= parse_path(
$options
{
'project-root'
},
$buildspec
->{path},
%args
);
%args
= write_extra_files(
extra_files
=>
$buildspec
->{
'extra-files'
},
extra
=>
$buildspec
->{extra},
args
=> \
%args
,
project_root
=>
$options
{
'project-root'
}
);
%args
= write_provides(
$buildspec
->{provides},
%args
);
%args
= write_pl_files(
$buildspec
->{pl_files},
%args
);
my
@boolean_args
=
qw( verbose v cleanup !x scandeps s require-versions !A )
;
foreach
my
$pair
( pairs
@boolean_args
) {
my
(
$key
,
$value
) = @{
$pair
};
if
(
$value
=~ /^\!(.*)$/xsm ) {
if
(
$options
{$1} ) {
delete
$options
{$1};
}
}
elsif
(
$options
{
$key
} ) {
$args
{
$value
} =
$EMPTY
;
}
}
foreach
my
$pair
( pairs
qw( destdir o extra f )
) {
my
(
$key
,
$value
) = @{
$pair
};
if
(
$buildspec
->{
$key
} ) {
$args
{
$value
} =
$buildspec
->{
$key
};
}
}
foreach
my
$k
(
keys
%args
) {
$args
{
$DASH
.
$k
} =
$args
{
$k
};
delete
$args
{
$k
};
}
DEBUG Dumper( [
args
=> \
%args
] );
return
%args
;
}
sub
create_temp_filelist {
my
(
$project_root
,
$filelist
) =
@_
;
if
(
ref
$filelist
&& reftype(
$filelist
) eq
'ARRAY'
) {
my
(
$fh
,
$filename
) = tempfile(
'make-cpan-dist-XXXXX'
,
TMPDIR
=>
$TRUE
);
foreach
my
$file
( @{
$filelist
} ) {
my
$path
=
$file
=~ /^\//xsm ?
$file
:
"$project_root/$file"
;
die
"error: no such file $path\n"
if
!-e
$path
;
print
{
$fh
}
"$path\n"
;
}
close
$fh
;
return
$filename
;
}
elsif
( !
ref
$filelist
) {
return
$filelist
if
-e
$filelist
;
die
"no such file $filelist\n"
;
}
}
sub
get_requires {
my
(
$requires
,
$core_modules
,
$min_perl_version
) =
@_
;
my
%modules
;
process_file(
$requires
,
chomp
=>
$TRUE
,
skip_blank_lines
=>
$TRUE
,
filter
=>
sub
{
my
(
$fh
,
$all_lines
,
$args
,
$line
) =
@_
;
$line
= filter(
$fh
,
$all_lines
,
$args
,
$line
);
return
()
if
$line
&&
$line
=~ /^perl\s+/xsm;
return
$line
if
!
defined
$line
;
return
$line
if
$core_modules
;
return
$line
if
$line
=~ /^[+]/xsm;
return
is_core(
$line
,
$min_perl_version
)
?
undef
:
$line
;
},
process
=>
sub
{
my
$line
=
pop
@_
;
$line
=~ s/^[+]([^+]*)$/$1/xsm;
my
(
$module
,
$version
) =
split
/\s/xsm,
$line
;
$version
=
$version
||
'0'
;
$modules
{
$module
} =
$version
;
return
$line
;
}
);
return
\
%modules
;
}
sub
get_modules {
my
(
$module_list
) =
@_
;
my
(
$modules
) = process_file(
$module_list
,
chomp
=>
$TRUE
);
return
$modules
;
}
sub
get_yaml_specfile {
my
(
$options
) =
@_
;
my
(
$lines
) = process_file(
*DATA
,
chomp
=>
$TRUE
,
next_line
=>
sub
{
my
(
$fh
,
$all_lines
,
$args
) =
@_
;
my
$line
= <
$fh
>;
return
if
!
$line
||
$line
=~ /^\=pod/xsm;
return
$line
;
}
);
return
Load
join
"\n"
, @{
$lines
};
}
sub
validate_object {
my
(
$obj
,
$spec
,
$err
) =
@_
;
$err
=
$err
// 0;
if
( reftype(
$obj
) eq
'HASH'
) {
foreach
my
$k
(
keys
%{
$obj
} ) {
if
( !
exists
$spec
->{
$k
} ) {
carp
"ERROR: not a valid key ($k)\n"
. Dumper [
$k
,
$spec
];
$err
++;
}
if
(
ref
$spec
->{
$k
} ) {
if
( !
ref
$obj
->{
$k
}
|| reftype(
$obj
->{
$k
} ) ne reftype(
$spec
->{
$k
} ) ) {
warn
"ERROR: wrong type for ($k) - $k must be "
. reftype(
$spec
->{
$k
} ) .
"\n"
;
$err
++;
}
else
{
validate_object(
$obj
->{
$k
},
$spec
->{
$k
},
$err
);
}
}
}
}
else
{
$err
= reftype(
$spec
) =~ /ARRAY|HASH/xsm;
}
return
$err
?
$FALSE
:
$TRUE
;
}
sub
fetch_relative_filelist {
my
(
$project_root
,
$file
) =
@_
;
my
@file_list
=
grep
{ !!
$_
}
split
/\n/xsm, slurp_file(
$file
);
foreach
(
@file_list
) {
s/
$project_root
\/?//xsm;
}
return
\
@file_list
;
}
sub
slurp_file {
my
(
$file
) =
@_
;
open
my
$fh
,
'<'
,
$file
or
die
"could not open $file for reading\n"
;
my
$content
= <
$fh
>;
close
$fh
;
return
$content
;
}
sub
main {
my
@option_specs
=
qw(
abstract|A=s
author|a=s
build-requires|B=s
buildspec|b=s
cleanup!
core-modules!
create-buildspec=s
debug|D
dryrun
exe-files|e=s
exec-path=s
extra-path=s
help|h
log-level|l=s
min-perl-version|M=s
module-path=s
module|m=s
overwrite
pager|P!
pl-files=s
postamble=s
project-root|p=s
recurse
require-versions|R!
requires|r=s
resources=s
scandeps|s
scripts-path=s
test-requires|t=s
tests-path=s
verbose|V
version-from=s
version|v
work-dir|w=s
)
;
my
%options
= (
cleanup
=> 1,
pager
=> 1 );
my
$retval
= GetOptions( \
%options
,
@option_specs
);
if
( !
$retval
||
$options
{help} ) {
help( \
%options
);
exit
;
}
$options
{
'project-root'
} //=
$ENV
{PROJECT_HOME} // getcwd;
$options
{
'yaml-spec'
} = get_yaml_specfile;
if
(
$options
{
'min-perl-version'
} ) {
$options
{
'min-perl-version'
}
= version->parse(
$options
{
'min-perl-version'
} )->stringify;
}
else
{
if
(
$options
{requires} ) {
$options
{
'min-perl-version'
} = get_perl_version(
$options
{requires} );
}
$options
{
'min-perl-version'
} //=
$DEFAULT_PERL_VERSION
;
}
if
( !
exists
$options
{
'require-versions'
} ) {
$options
{
'require-versions'
} =
$TRUE
;
}
if
(
$options
{version} ) {
print
$PROGRAM_NAME
.
' v'
.
$VERSION
.
$NL
;
exit
$SH_SUCCESS
;
}
my
$log_level
=
$options
{
'log-level'
};
if
(
$log_level
) {
if
(
$log_level
=~ /\A[1-5]\z$/xsm ) {
$log_level
= (
$ERROR
,
$WARN
,
$INFO
,
$DEBUG
,
$TRACE
)[
$log_level
- 1 ];
}
else
{
$log_level
= {
ERROR
=>
$ERROR
,
WARN
=>
$WARN
,
INFO
=>
$INFO
,
DEBUG
=>
$DEBUG
,
TRACE
=>
$TRACE
,
}->{
uc
$options
{
'log-level'
} };
}
}
elsif
(
$options
{debug} ) {
$log_level
=
$DEBUG
;
}
if
( !
$log_level
) {
$log_level
=
$ERROR
;
}
Log::Log4perl->easy_init(
$log_level
);
if
(
$options
{buildspec} ) {
my
%args
= parse_buildspec(
%options
);
if
(
$log_level
) {
$args
{
'-L'
} = {
$ERROR
=> 1,
$WARN
=> 2,
$INFO
=> 3,
$DEBUG
=> 4,
$TRACE
=> 5,
}->{
$log_level
};
}
if
( !
$options
{dryrun} ) {
exec
'make-cpan-dist '
.
join
$SPACE
,
%args
;
}
else
{
print
'make-cpan-dist '
. (
join
$SPACE
,
%args
) .
$NL
;
}
}
else
{
croak
'no module specified'
if
!
$options
{module};
croak
'no dependencies'
if
!
$options
{requires};
$options
{author} =
$options
{author} //
'Anonymouse <anonymouse@example.com>'
;
$options
{abstract} =
$options
{abstract} //
'my awesome Perl module!'
;
if
( !write_makefile(
%options
) ) {
help();
exit
$SH_FAILURE
;
}
}
exit
$SH_SUCCESS
;
}
1;