BEGIN {
if
(!
$ENV
{DIST_MGR_GIT_TEST} || !
$ENV
{DIST_MGR_REPO_DIR}) {
plan
skip_all
=>
"DIST_MGR_GIT_TEST and DIST_MGR_REPO_DIR env vars must be set"
;
}
}
my
@phases
=
qw(create dist cycle install release)
;
my
$repos_dir
=
$ENV
{DIST_MGR_REPO_DIR};
my
$repo
=
'test-module'
;
my
$repo_dir
=
"$repos_dir/$repo"
;
my
$cwd
= getcwd();
my
%cpan_args
= (
dry_run
=> 1,
);
{
before
(
'create'
);
system
(
"rm"
,
"-rf"
,
$repo_dir
);
my
@create_cmd_list
= (
'distmgr'
,
'create'
,
'--destroy'
,
'-m Test::Module'
,
'-a "Steve Bertrand"'
,
'-e steveb@cpan.org'
,
'-r test-module'
,
'-u stevieb9'
,
);
my
$cmd
=
join
' '
,
@create_cmd_list
;
my
$output
= `
$cmd
`;
my
$tpl_dir
=
"$cwd/t/data/distmgr/create_test-module"
;
copy_second_module(
$tpl_dir
,
'create'
);
compare_files(
$tpl_dir
,
'create'
);
after
();
}
{
before
(
'release'
);
my
$cmd
=
'distmgr release --nowait -d'
;
my
$output
= `
$cmd
`;
my
$tpl_dir
=
"$cwd/t/data/distmgr/release_test-module"
;
compare_files(
$tpl_dir
,
'release'
);
after
();
}
{
before
(
'cycle'
);
my
$pre_cycle_versions
= version_info();
my
$cmd
=
'distmgr cycle'
;
my
$output
= `
$cmd
`;
my
$tpl_dir
=
"$cwd/t/data/distmgr/cycle_test-module"
;
compare_files(
$tpl_dir
,
'cycle'
);
after
();
system
(
"rm"
,
"-rf"
,
$repo_dir
);
}
{
system
(
"rm"
,
"-rf"
,
't/temp'
);
mkdir
't/temp'
or
die
"Can't create t/temp dir: $!"
;
before
(
'dist'
);
my
@dist_cmd_list
= (
'distmgr'
,
'dist'
,
'-m Test::Module'
,
'-a "Steve Bertrand"'
,
'-e steveb@cpan.org'
,
);
my
$cmd
=
join
' '
,
@dist_cmd_list
;
my
$output
= `
$cmd
`;
chdir
'Test-Module'
or
die
"Can't change into Test-Module/ dir: $!"
;
like getcwd(),
qr|t/temp/Test-Module$|
,
"in t/temp/Test-Modules ok"
;
my
$tpl_dir
=
"$cwd/t/data/distmgr/dist_test-module"
;
copy_second_module(
$tpl_dir
,
'dist'
);
compare_files(
$tpl_dir
,
'dist'
);
after
();
}
{
before
(
'install'
);
is -e
'.github/workflows/github_ci_default.yml'
,
undef
,
"CI not created yet ok"
;
`distmgr install --ci --repo test-module --user stevieb9`;
file_count(18,
"--ci"
);
is -e
'.github/workflows/github_ci_default.yml'
, 1,
"CI config in place ok"
;
check_file(
'.github/workflows/github_ci_default.yml'
,
qr/PL2Bat/
,
"our custom CI config file is in place ok"
);
is -e
'.gitignore'
,
undef
,
".gitignore not created yet ok"
;
git_ignore();
is -e
'.gitignore'
, 1,
".gitignore in place ok"
;
check_file(
'.gitignore'
,
qr/BB-Pass/
,
"our custom .gitignore is in place ok"
);
`distmgr install --badges -u stevieb9 -r test-module`;
check_file(
'lib/Test/Module.pm'
,
qr/=for html/
,
"ci_badges() has html for loop ok"
);
check_file(
'lib/Test/Module.pm'
,
qr/coveralls/
,
"ci_badges() dropped coveralls ok"
);
check_file(
'lib/Test/Module.pm'
,
qr/workflows/
,
"ci_badges() dropped github actions ok"
);
`distmgr install --bugtracker -u stevieb9 -r test-module`;
check_file(
'Makefile.PL'
,
qr/META_MERGE/
,
"bugtrack META_MERGE added ok"
);
check_file(
'Makefile.PL'
,
qr/bugtracker/
,
"bugtracker added ok"
);
`distmgr install --repository -u stevieb9 -r test-module`;
check_file(
'Makefile.PL'
,
qr/META_MERGE/
,
"repo META_MERGE added ok"
);
check_file(
'Makefile.PL'
,
qr/repository/
,
"repository added ok"
);
after
();
system
(
"rm"
,
"-rf"
,
't/temp'
);
}
{
my
$file
= config_file();
remove_config(
$file
);
is -e
$file
,
undef
,
'no config file present ok'
;
`distmgr config`;
is -e
$file
, 1,
'config file present ok'
;
my
$data
= get_config(
$file
);
is
ref
$data
,
'HASH'
,
"config file data is a href ok"
;
is
$data
->{cpan_id},
''
,
"cpan_id empty string ok"
;
is
$data
->{cpan_pw},
''
,
"cpan_pw empty string ok"
;
remove_config(
$file
);
is -e
$file
,
undef
,
'no config file present ok'
;
}
cpan_restore();
done_testing;
sub
before
{
my
(
$phase
) =
@_
;
if
(!
defined
$phase
|| !
grep
/
$phase
/,
@phases
) {
croak(
"before() needs a phase sent in"
);
}
if
(
$phase
eq
'create'
) {
chdir
$repos_dir
or
die
"Can't chdir to $repos_dir"
;
like getcwd(),
qr/$repos_dir$/
,
"in $repos_dir directory ok"
;
die
"Not in $repos_dir!"
if
getcwd() !~ /
$repos_dir
$/;
}
elsif
(
$phase
eq
'dist'
) {
chdir
't/temp'
or
die
"Can't chdir to t/temp"
;
like getcwd(),
qr/t\/
temp$/,
"in t/temp directory ok"
;
die
"Not in t/temp!"
if
getcwd() !~ /t\/temp$/;
}
elsif
(
$phase
eq
'install'
) {
chdir
't/temp/Test-Module'
or
die
"Can't chdir to t/temp/Test-Module"
;
like getcwd(),
qr/t\/
temp\/Test-Module$/,
"in t/temp/Test-Module directory ok"
;
die
"Not in t/temp/Test-Module!"
if
getcwd() !~ /t\/temp\/Test-Module$/;
}
elsif
(
$phase
eq
'release'
||
$phase
eq
'cycle'
) {
chdir
$repo_dir
or
die
"Can't chdir to $repo_dir"
;
like getcwd(),
qr/$repo_dir$/
,
"in $repo_dir directory ok"
;
die
"Not in $repo_dir: $!"
if
getcwd() !~ /
$repo_dir
$/;
}
}
sub
after
{
chdir
$cwd
or
die
$!;
like getcwd(), _dist_dir_re(),
"back in root directory $cwd ok"
;
}
sub
file_count {
my
(
$expected_count
,
$msg
) =
@_
;
die
"need \$msg in file_count()"
if
!
defined
$msg
;
my
$fs_entry_count
;
find (
sub
{
$fs_entry_count
++;},
'.'
);
is
$fs_entry_count
,
$expected_count
,
"num files: $expected_count, $msg"
;
}
sub
check_file {
my
(
$file
,
$regex
,
$msg
) =
@_
;
open
my
$fh
,
'<'
,
$file
or
die
$!;
my
@contents
= <
$fh
>;
close
$fh
;
is
grep
(/
$regex
/,
@contents
) >= 1, 1,
$msg
;
}
sub
copy_second_module {
my
(
$src
,
$phase
) =
@_
;
croak(
"copy_second_module needs src dir sent in"
)
if
!
defined
$src
;
if
(!
defined
$phase
|| !
grep
/
$phase
/,
@phases
) {
croak(
"copy_second_module() needs a phase sent in. You sent $phase"
);
}
my
$dir
;
$dir
=
$repo_dir
if
$phase
eq
'create'
;
$dir
=
$repo_dir
if
$phase
eq
'release'
;
$dir
=
"$cwd/t/temp/Test-Module"
if
$phase
eq
'dist'
;
make_path
"$dir/lib/Test/Module"
or
die
"Can't create 'lib/Test/Module' dir in $dir"
;
copy
"$src/lib/Test/Module/Second.pm"
,
"$dir/lib/Test/Module/Second.pm"
or
die
"Can't copy Second.pm: $!"
;
is -e
"$dir/lib/Test/Module/Second.pm"
, 1,
"Second.pm copied ok to $dir/lib/Test/Module"
;
}
sub
compare_files {
if
(
@_
!= 2) {
die
"compare_files() needs \$tpl dir, and 'phase' sent in\n"
;
}
my
(
$tpl
,
$phase
) =
@_
;
my
$dir
;
$dir
=
$repo_dir
if
$phase
eq
'create'
;
$dir
=
$repo_dir
if
$phase
eq
'cycle'
;
$dir
=
$repo_dir
if
$phase
eq
'release'
;
$dir
=
"$cwd/t/temp/Test-Module"
if
$phase
eq
'dist'
;
chdir
$dir
or
die
"Can't go into $dir: $!\n"
;
like getcwd(),
qr/$dir$/
,
"in $dir directory ok"
;
my
@template_files
= File::Find::Rule->file()
->name(
'*'
)
->in(
$tpl
);
my
$file_count
= 0;
if
(1) {
my
@files
;
for
my
$tf
(
@template_files
) {
(
my
$nf
=
$tf
) =~ s/
$tpl
\///;
if
(-f
$nf
) {
next
if
$nf
=~ m|^\.git/|;
push
@files
,
$nf
;
open
my
$tfh
,
'<'
,
$tf
or
die
$!;
open
my
$nfh
,
'<'
,
$nf
or
die
$!;
my
@tf
= <
$tfh
>;
my
@nf
= <
$nfh
>;
close
$tfh
;
close
$nfh
;
for
(0 ..
$#tf
) {
if
(
$nf
eq
'Changes'
) {
if
(
$_
== 2) {
if
(
$phase
=~ /^create$/) {
like
$nf
[
$_
],
qr/0\.01 UNREL/
,
"Changes line 2 phase '$phase' contains UNREL ok"
;
next
;
}
if
(
$phase
=~ /^release$/) {
like
$nf
[
$_
],
qr/0\.01 \d{4}-\d{2}-\d{2}/
,
"Changes line 2 phase '$phase' has date ok"
;
unlike
$nf
[
$_
],
qr/UNREL/
,
"Changes line 2 phase '$phase' no UNREL ok"
;
next
;
}
if
(
$phase
=~ /^cycle$/) {
like
$nf
[
$_
],
qr/0\.02 UNREL/
,
"Changes line 2 phase '$phase' contains UNREL ok"
;
next
;
}
}
if
(
$_
== 5 &&
$phase
eq
'cycle'
) {
like
$nf
[
$_
],
qr/0\.01 \d{4}-\d{2}-\d{2}/
,
"Changes line 2 phase '$phase' has date ok"
;
next
;
}
if
(
$nf
[
$_
] =~ /^\s{4}-\s+$/) {
like
$nf
[
$_
],
qr/^\s{4}-\s+$/
,
"line with only a dash ok"
;
next
;
}
}
if
(
$nf
=~ m|lib/Test/.*\.pm|) {
if
(
$nf
[
$_
] =~ /\
$VERSION
/) {
like
$nf
[
$_
],
qr/\$VERSION = '\d+\.\d+'/
,
"Module has ver ok"
;
next
;
}
if
(
$nf
[
$_
] =~ /Copyright/) {
like
$nf
[
$_
],
qr/Copyright.*\d{4}/
,
"Module has copyright ok"
;
next
;
}
}
is
$nf
[
$_
],
$tf
[
$_
],
"$nf file matches the template $tf ok"
;
}
$file_count
++;
}
}
my
$base_count
=
scalar
@template_files
;
is
scalar
$file_count
,
$base_count
,
"file count matches number of files in module template"
;
}
else
{
warn
"SKIPPING $phase FILE COMPARE CHECKS!"
;
}
chdir
$cwd
or
die
"Can't go into $cwd: $!\n"
;
like getcwd(),
qr/$cwd$/
,
"in $cwd directory ok"
;
}
sub
done {
done_testing;
exit
;
}
sub
get_config {
my
(
$conf_file
) =
@_
;
{
local
$/;
open
my
$fh
,
'<'
,
$conf_file
or
die
"can't open $conf_file: $!"
;
my
$json
= <
$fh
>;
my
$perl
= decode_json(
$json
);
return
$perl
;
}
}
sub
remove_config {
my
(
$conf_file
) =
@_
;
if
(-e
$conf_file
) {
unlink
$conf_file
or
die
"Can't remove config file $conf_file: $!"
;
is -e
$conf_file
,
undef
,
"Removed config file $conf_file ok"
;
}
is -e
$conf_file
,
undef
,
"(unlink) config file $conf_file doesn't exist ok"
;
}