whoami7 - Manager
:
/
root
/
.cpanm
/
latest-build
/
CPAN-2.36
/
t
/
Upload File:
files >> //root/.cpanm/latest-build/CPAN-2.36/t/local_utils.pm
package local_utils; use Config; use Cwd; use File::Copy qw(cp); use File::Path qw(rmtree mkpath); use File::Spec (); 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"; # cp is not-overwriting on OS/2 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 $@; } # shamelessly stolen from Test::Builder sub mydiag { my(@msgs) = @_; my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; # Escape each line with a #. $msg =~ s/^/# /gm; # Stick a newline on the end if it needs it. $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 /(^\#[A-Za-z]:)/m, $ch; shift @s; # leading empty string 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", # get this test's own MyConfig "-Mblib", "-MCPAN::MyConfig_$$", "-Mlocal_utils", "-MCPAN", ($INC{"Devel/Cover.pm"} ? "-MDevel::Cover" : ()), # (@ARGV) ? "-d" : (), # force subtask into debug, maybe useful "-e", # "\$CPAN::Suppress_readline=1;shell('$prompt\n')", $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; # Local Variables: # mode: cperl # cperl-indent-level: 4 # End:
Copyright ©2021 || Defacer Indonesia