sub
_f ($) {File::Spec->catfile(
split
/\//,
shift
);}
sub
_d ($) {File::Spec->catdir(
split
/\//,
shift
);}
sub
prepare_dot_cpan {
rmtree _d
"t/dot-cpan-$$/sources"
;
rmtree _d
"t/dot-cpan-$$/build"
;
mkpath _d
"t/dot-cpan-$$/build"
;
rmtree _d
"t/dot-cpan-$$/prefs"
;
mkpath _d
"t/dot-cpan-$$/prefs"
;
unlink
_f
"t/dot-cpan-$$/Metadata"
;
unlink
_f
"t/dot-cpan-$$/.lock"
;
mkpath _d
"t/dot-cpan-$$/sources/authors/id/A/AN/ANDK"
;
mkpath _d
"t/dot-cpan-$$/Bundle"
;
unlink
_f
"t/CPAN/MyConfig_$$.pm"
, _f
"t/dot-cpan-$$/sources/MIRRORED.BY"
;
write_myconfig();
cp _f
"t/CPAN/TestMirroredBy"
, _f
"t/dot-cpan-$$/sources/MIRRORED.BY"
or
die
"Could not cp t/CPAN/TestMirroredBy over t/dot-cpan-$$/sources/MIRRORED.BY: $!"
;
}
sub
write_myconfig {
open
my
$fh
, _f
"t/CPAN/TestConfig.pm"
or
die
"Could not open 't/CPAN/TestConfig.pm': $!"
;
open
my
$fh2
,
">"
, _f
"t/CPAN/MyConfig_$$.pm"
or
die
"Could not open > t/CPAN/MyConfig_$$.pm: $!"
;
print
$fh2
"package CPAN::MyConfig_$$ ;\n"
;
while
(<
$fh
>) {
s/dot-cpan/dot-cpan-$$/g;
if
(/^__END__/) {
printf
$fh2
q{$INC{"CPAN/MyConfig.pm"}
=
$INC
{
"CPAN/MyConfig_%s.pm"
} =
'%s'
;
%s
},
$$, File::Spec->rel2abs(_f
"t/CPAN/MyConfig_$$.pm"
),
"\n"
;
}
print
$fh2
$_
;
}
close
$fh2
or
die
"Could not close t/CPAN/MyConfig_$$.pm: $!"
;
}
sub
cleanup_dot_cpan {
unlink
_f
"t/CPAN/MyConfig_$$.pm"
;
unlink
_f
"t/CPAN/MyConfig_$$.pm~"
;
unlink
_f
"t/dot-cpan-$$/sources/authors/id/A/AN/ANDK/CHECKSUMS"
;
unlink
_f
"t/dot-cpan-$$/sources/MIRRORED.BY"
;
unlink
_f
"t/dot-cpan-$$/prefs/FTPstats.yml"
;
unlink
_f
"t/dot-cpan-$$/prefs/TestDistroPrefsFile.yml"
;
unlink
_f
"t/dot-cpan-$$/prefs/ANDK.CPAN-Test-Dummy-Perl5-Make-Expect.yml"
;
rmtree _d
"t/dot-cpan-$$"
;
}
sub
read_myconfig () {
local
*FH
;
open
*FH
, _f
"t/CPAN/MyConfig_$$.pm"
or
die
"Could not read t/CPAN/MyConfig_$$.pm: $!"
;
my
$eval
=
do
{
local
($/); <FH>; };
eval
$eval
;
die
$@
if
$@;
}
sub
mydiag {
my
(
@msgs
) =
@_
;
my
$msg
=
join
''
,
map
{
defined
(
$_
) ?
$_
:
'undef'
}
@msgs
;
$msg
=~ s/^/
$msg
.=
"\n"
unless
$msg
=~ /\n\Z/;
print
$msg
;
}
sub
mreq ($) {
my
$m
=
shift
;
eval
"require $m; 1"
;
}
sub
splitchunk ($) {
my
$ch
=
shift
;
my
@s
=
split
/(^\
shift
@s
;
for
(
my
$i
= 0;
$i
<
@s
;
$i
+=2) {
$s
[
$i
] =~ s/\
$s
[
$i
] =~ s/://;
}
@s
;
}
sub
test_name {
my
(
$prog
,
$comment
) =
@_
;
(
$comment
||
""
) . (
$prog
?
" (testing command '$prog')"
:
"[empty RET]"
)
}
sub
run_shell_cmd_lit ($$) {
my
$cwd
=
shift
;
my
$dup_pid
=
shift
;
my
$t
= File::Spec->catfile(
$cwd
,
"t"
);
my
@system
= (
$^X,
"-I$t"
,
"-Mblib"
,
"-MCPAN::MyConfig_$$"
,
"-Mlocal_utils"
,
"-MCPAN"
,
(
$INC
{
"Devel/Cover.pm"
} ?
"-MDevel::Cover"
: ()),
"-e"
,
$dup_pid
? (
"local_utils::dup_pid_inc($dup_pid);"
,
"-e"
) : (),
"\@CPAN::Defaultsites = (); shell"
,
);
}
sub
dup_pid_inc {
my
(
$pid
) =
@_
;
$INC
{
qq{CPAN/MyConfig.pm}
} =
$INC
{
qq{CPAN/MyConfig_$pid.pm}
};
}
1;