sub
diag {
my
$handle
= \
*STDERR
;
for
(
@_
) {
print
{
$handle
}
$_
;
}
print
{
$handle
}
"\n"
;
}
sub
env_exists {
return
exists
$ENV
{
$_
[0] };
}
sub
env_true {
return
( env_exists(
$_
[0] ) and
$ENV
{
$_
[0] } );
}
sub
env_is {
return
( env_exists(
$_
[0] ) and
$ENV
{
$_
[0] } eq
$_
[1] ) }
sub
safe_exec_nonfatal {
my
(
$command
,
@params
) =
@_
;
diag(
"running $command @params"
);
my
$exit
=
system
(
$command
,
@params
);
if
(
$exit
!= 0 ) {
my
$low
=
$exit
& 0b11111111;
my
$high
=
$exit
>> 8;
warn
"$command failed: $? $! and exit = $high , flags = $low"
;
if
(
$high
!= 0 ) {
return
$high
;
}
else
{
return
1;
}
}
return
0;
}
sub
safe_exec {
my
(
$command
,
@params
) =
@_
;
my
$exit_code
= safe_exec_nonfatal(
$command
,
@params
);
if
(
$exit_code
!= 0 ) {
exit
$exit_code
;
}
return
1;
}
sub
cpanm {
my
(
@params
) =
@_
;
my
$exit_code
= safe_exec_nonfatal(
'cpanm'
,
@params
);
if
(
$exit_code
!= 0 ) {
safe_exec(
'tail'
,
'-n'
,
'200'
,
'/home/travis/.cpanm/build.log'
);
exit
$exit_code
;
}
return
1;
}
sub
git {
my
(
@params
) =
@_
;
safe_exec(
'git'
,
@params
);
}
my
$got_fixes
;
sub
get_fixes {
return
if
$got_fixes
;
my
$cwd
= cwd();
chdir
'/tmp'
;
chdir
$cwd
;
$got_fixes
= 1;
}
my
$got_sterile
;
sub
get_sterile {
return
if
$got_sterile
;
my
$cwd
= cwd();
chdir
'/tmp'
;
my
$version
= $];
safe_exec(
'git'
,
'clone'
,
'--depth=1'
,
'--branch='
.
$version
,
'perl5-sterile'
);
chdir
$cwd
;
$got_sterile
= 1;
}
my
$fixed_up
;
sub
fixup_sterile {
return
if
$fixed_up
;
get_sterile();
my
$cwd
= cwd();
chdir
'/tmp/perl5-sterile'
;
safe_exec(
'bash'
,
'patch_fixlist.sh'
,
'/home/travis/perl5/perlbrew/perls/'
.
$ENV
{TRAVIS_PERL_VERSION} );
chdir
$cwd
;
$fixed_up
= 1;
}
my
$sterile_deployed
;
sub
deploy_sterile {
return
if
$sterile_deployed
;
fixup_sterile();
for
my
$key
(
keys
%Config
) {
next
unless
$key
=~ /(lib|arch)
exp
$/;
my
$value
=
$Config
{
$key
};
next
unless
defined
$value
;
next
unless
length
$value
;
my
$clean_path
=
'/tmp/perl5-sterile/'
.
$key
;
diag(
"\e[32m?$clean_path\e[0m"
);
if
( -e
$clean_path
and -d
$clean_path
) {
diag(
"\e[31mRsyncing over $value\e[0m"
);
$clean_path
=~ s{/?$}{/};
$value
=~ s{/?$}{/};
safe_exec(
'rsync'
,
'-a'
,
'--delete-delay'
,
$clean_path
,
$value
);
}
}
}
sub
cpanm_fix {
my
(
@params
) =
@_
;
get_fixes();
my
$cwd
= cwd();
chdir
'/tmp/cpan-fixes'
;
cpanm(
@params
);
chdir
$cwd
;
}
sub
parse_meta_json {
$_
[0] ||=
'META.json'
;
return
CPAN::Meta->load_file(
$_
[0] );
}
sub
capture_stdout(&) {
goto
&Capture::Tiny::capture_stdout
;
}
sub
import
{
my
(
$self
,
@args
) =
@_
;
my
$caller
= [
caller
]->[0];
my
$caller_stash
=
do
{
no
strict
'refs'
;
*{
$caller
.
'::'
};
};
$caller_stash
->{diag} =
*diag
;
$caller_stash
->{env_exists} =
*env_exists
;
$caller_stash
->{env_true} =
*env_true
;
$caller_stash
->{env_is} =
*env_is
;
$caller_stash
->{safe_exec_nonfatal} =
*safe_exec_nonfatal
;
$caller_stash
->{safe_exec} =
*safe_exec
;
$caller_stash
->{cpanm} =
*cpanm
;
$caller_stash
->{git} =
*git
;
$caller_stash
->{get_fixes} =
*get_fixes
;
$caller_stash
->{cpanm_fix} =
*cpanm_fix
;
$caller_stash
->{parse_meta_json} =
*parse_meta_json
;
$caller_stash
->{capture_stdout} =
*capture_stdout
;
$caller_stash
->{deploy_sterile} =
*deploy_sterile
;
}
1;