1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
#!perl
use strict;
use warnings;
use FindBin;
use File::Copy qw(copy);
use File::Spec;
use File::Temp;
use Test::More;
sub copy_log_file {
my ( $home ) = @_;
my $log_file = File::Spec->catfile($home, '.cpanm', 'build.log');
my $tempfile = File::Temp->new(
SUFFIX => '.log',
UNLINK => 0,
);
copy($log_file, $tempfile->filename);
diag("For details, please consult $tempfile")
}
sub is_dist_root {
my ( @path ) = @_;
return -e File::Spec->catfile(@path, 'Makefile.PL') ||
-e File::Spec->catfile(@path, 'Build.PL');
}
delete @ENV{qw/AUTHOR_TESTING RELEASE_TESTING PERL5LIB/};
unless($ENV{'PERLBREW_ROOT'}) {
plan skip_all => "Environment variable 'PERLBREW_ROOT' not found";
exit;
}
my $brew = q[pristine-5.16];
my $cpanm_path = qx(which cpanm 2>/dev/null);
unless($cpanm_path) {
plan skip_all => "The 'cpanm' program is required to run this test";
exit;
}
chomp $cpanm_path;
my $perlbrew_bin = File::Spec->catdir($ENV{'PERLBREW_ROOT'}, 'perls',
$brew, 'bin');
my $perlbrew_path = $ENV{'PATH'};
if(my $local_lib_root = $ENV{'PERL_LOCAL_LIB_ROOT'}) {
my @path = File::Spec->path;
while(@path && $path[0] =~ /^$local_lib_root/) {
shift @path;
}
if($^O eq 'MSWin32') {
$perlbrew_path = join(';', @path);
} else {
$perlbrew_path = join(':', @path);
}
}
my ( $env, $status ) = do {
local $ENV{'PATH'} = $perlbrew_path;
local $ENV{'SHELL'} = '/bin/bash'; # fool perlbrew
( scalar(qx(perlbrew env $brew)), $? )
};
unless($status == 0) {
plan skip_all => "No such perlbrew environment '$brew'";
exit;
}
my @lines = split /\n/, $env;
foreach my $line (@lines) {
if($line =~ /^\s*export\s+([0-9a-zA-Z_]+)=(.*)$/) {
my ( $k, $v ) = ( $1, $2 );
if($v =~ /^("|')(.*)\1$/) {
$v = $2;
$v =~ s!\\(.)!$1!ge;
}
$ENV{$k} = $v;
} elsif($line =~ /^unset\s+([0-9a-zA-Z_]+)/) {
delete $ENV{$1};
}
}
my $pristine_path = do {
local $ENV{'PATH'} = $perlbrew_path;
qx(perlbrew display-pristine-path);
};
chomp $pristine_path;
$ENV{'PATH'} = join(':', $ENV{'PERLBREW_PATH'}, $pristine_path);
plan tests => 1;
my $tmpdir = File::Temp->newdir;
my $tmphome = File::Temp->newdir;
my $pid = fork;
if(!defined $pid) {
fail "Forking failed!";
exit 1;
} elsif($pid) {
waitpid $pid, 0;
ok !$?, "cpanm should successfully install your dist with no issues" or copy_log_file($tmphome->dirname);
} else {
open STDIN, '<', File::Spec->devnull;
open STDOUT, '>', File::Spec->devnull;
open STDERR, '>', File::Spec->devnull;
my @path = File::Spec->splitdir($FindBin::Bin);
while(@path && !is_dist_root(@path)) {
pop @path;
}
unless(@path) {
die "Unable to find dist root\n";
}
chdir File::Spec->catdir(@path); # exit test directory
# override where cpanm puts its log file
$ENV{'HOME'} = $tmphome->dirname;
# We use system here instead of exec so that $tmpdir gets cleaned up
# after cpanm finishes
system 'perl', $cpanm_path, '-L', $tmpdir->dirname, '.';
exit($? >> 8);
}
|
