This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Explicitly set the location of cpanp-run-perl when under PERL_CORE
[perl5.git] / cpan / CPANPLUS-Dist-Build / t / inc / conf.pl
1 ### On VMS, the ENV is not reset after the program terminates.
2 ### So reset it here explicitly
3 my ($old_env_path, $old_env_perl5lib);
4 BEGIN {
5     use FindBin; 
6     use File::Spec;
7     
8     ### paths to our own 'lib' and 'inc' dirs
9     ### include them, relative from t/
10     my @paths   = map { "$FindBin::Bin/$_" } qw[../lib inc];
11
12     ### absolute'ify the paths in @INC;
13     my @rel2abs = map { File::Spec->rel2abs( $_ ) }
14                     grep { not File::Spec->file_name_is_absolute( $_ ) } @INC;
15     
16     ### use require to make devel::cover happy
17     require lib;
18     for ( @paths, @rel2abs ) { 
19         my $l = 'lib'; 
20         $l->import( $_ ) 
21     }
22
23     use Config;
24
25     ### and add them to the environment, so shellouts get them
26     $old_env_perl5lib = $ENV{'PERL5LIB'};
27     $ENV{'PERL5LIB'}  = join $Config{'path_sep'}, 
28                         grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs;
29     
30     ### add CPANPLUS' bin dir to the front of $ENV{PATH}, so that cpanp-run-perl
31     ### and friends get picked up, only under PERL_CORE though.
32     if ( $ENV{PERL_CORE} ) {
33        $old_env_path = $ENV{PATH};
34        $ENV{'PATH'}  = join $Config{'path_sep'}, 
35                     grep { defined } "$FindBin::Bin/../../CPANPLUS/bin", $ENV{'PATH'};
36
37     }
38
39     ### Fix up the path to perl, as we're about to chdir
40     ### but only under perlcore, or if the path contains delimiters,
41     ### meaning it's relative, but not looked up in your $PATH
42     $^X = File::Spec->rel2abs( $^X ) 
43         if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| );
44
45     ### chdir to our own test dir, so we know all files are relative 
46     ### to this point, no matter whether run from perlcore tests or
47     ### regular CPAN installs
48     chdir "$FindBin::Bin" if -d "$FindBin::Bin"
49 }
50
51 BEGIN {
52     use IPC::Cmd;
53    
54     ### Win32 has issues with redirecting FD's properly in IPC::Run:
55     ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801
56     $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
57     $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
58 }
59
60 ### Use a $^O comparison, as depending on module at this time
61 ### may cause weird errors/warnings
62 END {
63     if ($^O eq 'VMS') {
64         ### VMS environment variables modified by this test need to be put back
65         ### path is "magic" on VMS, we can not tell if it really existed before
66         ### this was run, because VMS will magically pretend that a PATH
67         ### environment variable exists set to the current working directory
68         $ENV{PATH} = $old_env_path;
69
70         if (defined $old_env_perl5lib) {
71             $ENV{PERL5LIB} = $old_env_perl5lib;
72         } else {
73             delete $ENV{PERL5LIB};
74         }
75     }
76 }
77
78 use strict;
79 use CPANPLUS::Configure;
80 use CPANPLUS::Error ();
81
82 use File::Path      qw[rmtree];
83 use FileHandle;
84 use File::Basename  qw[basename];
85
86 {   ### Force the ignoring of .po files for L::M::S
87     $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__;
88     $Locale::Maketext::Lexicon::VERSION = 0;
89 }
90
91 my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE';
92
93 # prereq has to be in our package file && core!
94 use constant TEST_CONF_PREREQ           => 'Cwd';   
95 use constant TEST_CONF_MODULE           => 'Foo::Bar::EU::NOXS';
96 use constant TEST_CONF_MODULE_SUB       => 'Foo::Bar::EU::NOXS::Sub';
97 use constant TEST_CONF_AUTHOR           => 'EUNOXS';
98 use constant TEST_CONF_INST_MODULE      => 'Foo::Bar';
99 use constant TEST_CONF_INVALID_MODULE   => 'fnurk';
100 use constant TEST_CONF_MIRROR_DIR       => 'dummy-localmirror';
101 use constant TEST_CONF_CPAN_DIR         => 'dummy-CPAN';
102 use constant TEST_CONF_CPANPLUS_DIR     => 'dummy-cpanplus';
103 use constant TEST_CONF_INSTALL_DIR      => File::Spec->rel2abs(
104                                                 File::Spec->catdir(      
105                                                     TEST_CONF_CPANPLUS_DIR,
106                                                     'install'
107                                                 )
108                                             );       
109
110 ### we might need this Some Day when we're installing into
111 ### our own sandbox. see t/20.t for details
112 # use constant TEST_INSTALL_DIR       => do {
113 #     my $dir = File::Spec->rel2abs( 'dummy-perl' );
114
115 #     ### clean up paths if we are on win32    
116 #     ### dirs with spaces will be.. bad :(
117 #     $^O eq 'MSWin32'
118 #         ? Win32::GetShortPathName( $dir )
119 #         : $dir;
120 # };        
121
122 # use constant TEST_INSTALL_DIR_LIB 
123 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' );
124 # use constant TEST_INSTALL_DIR_BIN 
125 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' );
126 # use constant TEST_INSTALL_DIR_MAN1 
127 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' );
128 # use constant TEST_INSTALL_DIR_MAN3
129 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' );
130 # use constant TEST_INSTALL_DIR_ARCH
131 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' );
132
133 # use constant TEST_INSTALL_EU_MM_FLAGS =>
134 #     ' INSTALLDIRS=site' .
135 #     ' INSTALLSITELIB='     . TEST_INSTALL_DIR_LIB .
136 #     ' INSTALLSITEARCH='    . TEST_INSTALL_DIR_ARCH .    # .packlist
137 #     ' INSTALLARCHLIB='     . TEST_INSTALL_DIR_ARCH .    # perllocal.pod
138 #     ' INSTALLSITEBIN='     . TEST_INSTALL_DIR_BIN .
139 #     ' INSTALLSCRIPT='      . TEST_INSTALL_DIR_BIN .
140 #     ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 .
141 #     ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3;
142
143
144 sub dummy_cpan_dir {
145     ### VMS needs this in directory format for rel2abs
146     my $test_dir = $^O eq 'VMS'
147                     ? File::Spec->catdir(TEST_CONF_CPAN_DIR)
148                     : TEST_CONF_CPAN_DIR;
149
150     ### Convert to an absolute file specification
151     my $abs_test_dir = File::Spec->rel2abs($test_dir);
152     
153     ### According to John M: the hosts path needs to be in UNIX format.  
154     ### File::Spec::Unix->rel2abs does not work at all on VMS
155     $abs_test_dir    = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS';
156
157     return $abs_test_dir;
158 }
159
160 sub gimme_conf { 
161
162     ### don't load any other configs than the heuristic one
163     ### during tests. They might hold broken/incorrect data
164     ### for our test suite. Bug [perl #43629] showed this.
165     my $conf = CPANPLUS::Configure->new( load_configs => 0 );
166
167     my $dummy_cpan = dummy_cpan_dir();
168     
169     $conf->set_conf( hosts  => [ { 
170                         path        => $dummy_cpan,
171                         scheme      => 'file',
172                     } ],      
173     );
174     $conf->set_conf( base       => File::Spec->rel2abs(TEST_CONF_CPANPLUS_DIR));
175     $conf->set_conf( dist_type  => '' );
176     $conf->set_conf( signature  => 0 );
177     $conf->set_conf( verbose    => 1 ) if $ENV{ $Env };
178     
179     ### never use a pager in the test suite
180     $conf->set_program( pager   => '' );
181
182     ### dmq tells us that we should run with /nologo
183     ### if using nmake, as it's very noisy otherwise.
184     {   my $make = $conf->get_program('make');
185         if( $make and basename($make) =~ /^nmake/i ) {
186             $conf->set_conf( makeflags => '/nologo' );
187         }
188     }
189
190     ### CPANPLUS::Config checks 3 specific scenarios first
191     ### when looking for cpanp-run-perl: parallel to cpanp,
192     ### parallel to CPANPLUS.pm, or installed into a custom
193     ### prefix like /tmp/foo. Only *THEN* does it check the
194     ### the path.
195     ### If the perl core is extracted to a directory that has
196     ### cpanp-run-perl installed the same amount of 'uplevels'
197     ### as the /tmp/foo prefix, we'll pull in the wrong script
198     ### by accident.
199     ### Since we set the path to cpanp-run-perl explicitily
200     ### at the top of this script, it's best to update the config
201     ### ourselves with a path lookup, rather than rely on its
202     ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent
203     ### Pit for helping to track this down.
204     if( $ENV{PERL_CORE} ) {
205         $conf->set_program( "perlwrapper" => IPC::Cmd::can_run('cpanp-run-perl') );
206     }
207
208     $conf->set_conf( source_engine =>  $ENV{CPANPLUS_SOURCE_ENGINE} )
209         if $ENV{CPANPLUS_SOURCE_ENGINE};
210     
211     _clean_test_dir( [
212         $conf->get_conf('base'),     
213         TEST_CONF_MIRROR_DIR,
214 #         TEST_INSTALL_DIR_LIB,
215 #         TEST_INSTALL_DIR_BIN,
216 #         TEST_INSTALL_DIR_MAN1, 
217 #         TEST_INSTALL_DIR_MAN3,
218     ], (  $ENV{PERL_CORE} ? 0 : 1 ) );
219         
220     return $conf;
221 };
222
223 # placeholder
224
225 ### clean these files if we're under perl core
226 END { 
227     if ( $ENV{PERL_CORE} ) {
228
229         _clean_test_dir( [
230             gimme_conf->get_conf('base'),   
231             TEST_CONF_MIRROR_DIR,
232     #         TEST_INSTALL_DIR_LIB,
233     #         TEST_INSTALL_DIR_BIN,
234     #         TEST_INSTALL_DIR_MAN1, 
235     #         TEST_INSTALL_DIR_MAN3,
236         ], 0 ); # DO NOT be verbose under perl core -- makes tests fail
237     }
238 }
239
240 ### whenever we start a new script, we want to clean out our
241 ### old files from the test '.cpanplus' dir..
242 sub _clean_test_dir {
243     my $dirs    = shift || [];
244     my $verbose = shift || 0;
245
246     for my $dir ( @$dirs ) {
247
248         ### no point if it doesn't exist;
249         next unless -d $dir;
250
251         my $dh;
252         opendir $dh, $dir or die "Could not open basedir '$dir': $!";
253         while( my $file = readdir $dh ) { 
254             next if $file =~ /^\./;  # skip dot files
255             
256             my $path = File::Spec->catfile( $dir, $file );
257             
258             ### directory, rmtree it
259             if( -d $path ) {
260
261                 ### John Malmberg reports yet another VMS issue:
262                 ### A directory name on VMS in VMS format ends with .dir 
263                 ### when it is referenced as a file.
264                 ### In UNIX format traditionally PERL on VMS does not remove the
265                 ### '.dir', however the VMS C library conversion routines do
266                 ### remove the '.dir' and the VMS C library routines can not 
267                 ### handle the '.dir' being present on UNIX format filenames.
268                 ### So code doing the fixup has on VMS has to be able to handle 
269                 ### both UNIX format names and VMS format names. 
270                 
271                 ### XXX See http://www.xray.mpe.mpg.de/
272                 ### mailing-lists/perl5-porters/2007-10/msg00064.html
273                 ### for details -- the below regex could use some touchups
274                 ### according to John. M.            
275                 $file =~ s/\.dir$//i if $^O eq 'VMS';
276                 
277                 my $dirpath = File::Spec->catdir( $dir, $file );
278
279                 print "# Deleting directory '$dirpath'\n" if $verbose;
280                 eval { rmtree( $dirpath ) };
281                 warn "Could not delete '$dirpath' while cleaning up '$dir'" 
282                     if $@;
283            
284             ### regular file
285             } else {
286                 print "# Deleting file '$path'\n" if $verbose;
287                 1 while unlink $path;
288             }            
289         }       
290     
291         close $dh;
292     }
293     
294     return 1;
295 }
296 1;