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