Commit | Line | Data |
6aaee015 |
1 | BEGIN { |
2 | use FindBin; |
3 | use File::Spec; |
4 | |
5 | ### paths to our own 'lib' and 'inc' dirs |
6 | ### include them, relative from t/ |
7 | my @paths = map { "$FindBin::Bin/$_" } qw[../lib inc]; |
8 | |
9 | ### absolute'ify the paths in @INC; |
10 | my @rel2abs = map { File::Spec->rel2abs( $_ ) } |
11 | grep { not File::Spec->file_name_is_absolute( $_ ) } @INC; |
12 | |
13 | ### use require to make devel::cover happy |
14 | require lib; |
15 | for ( @paths, @rel2abs ) { |
16 | my $l = 'lib'; |
17 | $l->import( $_ ) |
18 | } |
19 | |
20 | use Config; |
21 | |
22 | ### and add them to the environment, so shellouts get them |
23 | $ENV{'PERL5LIB'} = join ':', |
24 | grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs; |
25 | |
26 | ### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl |
27 | ### and friends get picked up |
28 | $ENV{'PATH'} = join $Config{'path_sep'}, |
29 | grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'}; |
30 | |
31 | ### Fix up the path to perl, as we're about to chdir |
32 | ### but only under perlcore, or if the path contains delimiters, |
33 | ### meaning it's relative, but not looked up in your $PATH |
34 | $^X = File::Spec->rel2abs( $^X ) |
35 | if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| ); |
36 | |
37 | ### chdir to our own test dir, so we know all files are relative |
38 | ### to this point, no matter whether run from perlcore tests or |
39 | ### regular CPAN installs |
40 | chdir "$FindBin::Bin" if -d "$FindBin::Bin" |
41 | } |
42 | |
43 | BEGIN { |
44 | use IPC::Cmd; |
45 | |
46 | ### Win32 has issues with redirecting FD's properly in IPC::Run: |
47 | ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801 |
48 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
49 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
50 | } |
51 | |
52 | use strict; |
53 | use CPANPLUS::Configure; |
54 | |
55 | use File::Path qw[rmtree]; |
56 | use FileHandle; |
57 | use File::Basename qw[basename]; |
58 | |
59 | { ### Force the ignoring of .po files for L::M::S |
60 | $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__; |
61 | $Locale::Maketext::Lexicon::VERSION = 0; |
62 | } |
63 | |
64 | # prereq has to be in our package file && core! |
65 | use constant TEST_CONF_PREREQ => 'Cwd'; |
66 | use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS'; |
67 | use constant TEST_CONF_INST_MODULE => 'Foo::Bar'; |
68 | use constant TEST_CONF_INVALID_MODULE => 'fnurk'; |
494f1016 |
69 | use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror'; |
6aaee015 |
70 | |
71 | ### we might need this Some Day when we're installing into |
72 | ### our own sandbox. see t/20.t for details |
73 | # use constant TEST_INSTALL_DIR => do { |
74 | # my $dir = File::Spec->rel2abs( 'dummy-perl' ); |
75 | # |
76 | # ### clean up paths if we are on win32 |
77 | # ### dirs with spaces will be.. bad :( |
78 | # $^O eq 'MSWin32' |
79 | # ? Win32::GetShortPathName( $dir ) |
80 | # : $dir; |
81 | # }; |
82 | |
83 | # use constant TEST_INSTALL_DIR_LIB |
84 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' ); |
85 | # use constant TEST_INSTALL_DIR_BIN |
86 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' ); |
87 | # use constant TEST_INSTALL_DIR_MAN1 |
88 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' ); |
89 | # use constant TEST_INSTALL_DIR_MAN3 |
90 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' ); |
91 | # use constant TEST_INSTALL_DIR_ARCH |
92 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' ); |
93 | # |
94 | # use constant TEST_INSTALL_EU_MM_FLAGS => |
95 | # ' INSTALLDIRS=site' . |
96 | # ' INSTALLSITELIB=' . TEST_INSTALL_DIR_LIB . |
97 | # ' INSTALLSITEARCH=' . TEST_INSTALL_DIR_ARCH . # .packlist |
98 | # ' INSTALLARCHLIB=' . TEST_INSTALL_DIR_ARCH . # perllocal.pod |
99 | # ' INSTALLSITEBIN=' . TEST_INSTALL_DIR_BIN . |
100 | # ' INSTALLSCRIPT=' . TEST_INSTALL_DIR_BIN . |
101 | # ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 . |
102 | # ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3; |
103 | |
104 | |
105 | sub gimme_conf { |
106 | my $conf = CPANPLUS::Configure->new(); |
107 | $conf->set_conf( hosts => [ { |
108 | path => 'dummy-CPAN', |
109 | scheme => 'file', |
110 | } ], |
111 | ); |
112 | $conf->set_conf( base => 'dummy-cpanplus' ); |
113 | $conf->set_conf( dist_type => '' ); |
114 | $conf->set_conf( signature => 0 ); |
115 | |
622d31ac |
116 | ### dmq tells us that we should run with /nologo |
117 | ### if using nmake, as it's very noise otherwise. |
118 | { my $make = $conf->get_program('make'); |
119 | if( $make and basename($make) =~ /^nmake/i and |
120 | $make !~ m|/nologo| |
121 | ) { |
122 | $make .= ' /nologo'; |
123 | $conf->set_program( make => $make ); |
124 | } |
125 | } |
126 | |
6aaee015 |
127 | _clean_test_dir( [ |
128 | $conf->get_conf('base'), |
494f1016 |
129 | TEST_CONF_MIRROR_DIR, |
6aaee015 |
130 | # TEST_INSTALL_DIR_LIB, |
131 | # TEST_INSTALL_DIR_BIN, |
132 | # TEST_INSTALL_DIR_MAN1, |
133 | # TEST_INSTALL_DIR_MAN3, |
53873a16 |
134 | ], ( $ENV{PERL_CORE} ? 0 : 1 ) ); |
6aaee015 |
135 | |
136 | return $conf; |
137 | }; |
138 | |
494f1016 |
139 | { |
140 | my $fh; |
141 | my $file = ".".basename($0).".output"; |
142 | sub output_handle { |
143 | return $fh if $fh; |
144 | |
145 | $fh = FileHandle->new(">$file") |
146 | or warn "Could not open output file '$file': $!"; |
147 | |
148 | $fh->autoflush(1); |
149 | return $fh; |
150 | } |
6aaee015 |
151 | |
494f1016 |
152 | sub output_file { return $file } |
6aaee015 |
153 | } |
154 | |
494f1016 |
155 | |
156 | ### clean these files if we're under perl core |
157 | END { |
158 | if ( $ENV{PERL_CORE} ) { |
159 | close output_handle(); 1 while unlink output_file(); |
160 | |
161 | _clean_test_dir( [ |
162 | gimme_conf->get_conf('base'), |
163 | TEST_CONF_MIRROR_DIR, |
164 | # TEST_INSTALL_DIR_LIB, |
165 | # TEST_INSTALL_DIR_BIN, |
166 | # TEST_INSTALL_DIR_MAN1, |
167 | # TEST_INSTALL_DIR_MAN3, |
53873a16 |
168 | ], 0 ); # DO NOT be verbose under perl core -- makes tests fail |
494f1016 |
169 | } |
170 | } |
171 | |
172 | |
6aaee015 |
173 | |
174 | ### whenever we start a new script, we want to clean out our |
175 | ### old files from the test '.cpanplus' dir.. |
176 | sub _clean_test_dir { |
177 | my $dirs = shift || []; |
178 | my $verbose = shift || 0; |
179 | |
180 | for my $dir ( @$dirs ) { |
181 | |
53873a16 |
182 | ### no point if it doesn't exist; |
183 | next unless -d $dir; |
184 | |
6aaee015 |
185 | my $dh; |
186 | opendir $dh, $dir or die "Could not open basedir '$dir': $!"; |
187 | while( my $file = readdir $dh ) { |
188 | next if $file =~ /^\./; # skip dot files |
189 | |
190 | my $path = File::Spec->catfile( $dir, $file ); |
191 | |
192 | ### directory, rmtree it |
193 | if( -d $path ) { |
53873a16 |
194 | print "# Deleting directory '$path'\n" if $verbose; |
6aaee015 |
195 | eval { rmtree( $path ) }; |
196 | warn "Could not delete '$path' while cleaning up '$dir'" if $@; |
197 | |
198 | ### regular file |
199 | } else { |
200 | print "Deleting file '$path'\n" if $verbose; |
201 | 1 while unlink $path; |
202 | } |
203 | } |
204 | |
205 | close $dh; |
206 | } |
207 | |
208 | return 1; |
209 | } |
210 | 1; |