1package MakeMaker::Test::Utils; 2 3use File::Spec; 4use strict; 5use Config; 6 7use vars qw($VERSION @ISA @EXPORT); 8 9require Exporter; 10@ISA = qw(Exporter); 11 12$VERSION = 0.02; 13 14@EXPORT = qw(which_perl perl_lib makefile_name makefile_backup 15 make make_run run make_macro calibrate_mtime 16 ); 17 18my $Is_VMS = $^O eq 'VMS'; 19my $Is_MacOS = $^O eq 'MacOS'; 20 21 22=head1 NAME 23 24MakeMaker::Test::Utils - Utility routines for testing MakeMaker 25 26=head1 SYNOPSIS 27 28 use MakeMaker::Test::Utils; 29 30 my $perl = which_perl; 31 perl_lib; 32 33 my $makefile = makefile_name; 34 my $makefile_back = makefile_backup; 35 36 my $make = make; 37 my $make_run = make_run; 38 make_macro($make, $targ, %macros); 39 40 my $mtime = calibrate_mtime; 41 42 my $out = run($cmd); 43 44=head1 DESCRIPTION 45 46A consolidation of little utility functions used through out the 47MakeMaker test suite. 48 49=head2 Functions 50 51The following are exported by default. 52 53=over 4 54 55=item B<which_perl> 56 57 my $perl = which_perl; 58 59Returns a path to perl which is safe to use in a command line, no 60matter where you chdir to. 61 62=cut 63 64sub which_perl { 65 my $perl = $^X; 66 $perl ||= 'perl'; 67 68 # VMS should have 'perl' aliased properly 69 return $perl if $Is_VMS; 70 71 $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i; 72 73 my $perlpath = File::Spec->rel2abs( $perl ); 74 unless( $Is_MacOS || -x $perlpath ) { 75 # $^X was probably 'perl' 76 77 # When building in the core, *don't* go off and find 78 # another perl 79 die "Can't find a perl to use (\$^X=$^X), (\$perlpath=$perlpath)" 80 if $ENV{PERL_CORE}; 81 82 foreach my $path (File::Spec->path) { 83 $perlpath = File::Spec->catfile($path, $perl); 84 last if -x $perlpath; 85 } 86 } 87 88 return $perlpath; 89} 90 91=item B<perl_lib> 92 93 perl_lib; 94 95Sets up environment variables so perl can find its libraries. 96 97=cut 98 99my $old5lib = $ENV{PERL5LIB}; 100my $had5lib = exists $ENV{PERL5LIB}; 101sub perl_lib { 102 # perl-src/t/ 103 my $lib = $ENV{PERL_CORE} ? qq{../lib} 104 # ExtUtils-MakeMaker/t/ 105 : qq{../blib/lib}; 106 $lib = File::Spec->rel2abs($lib); 107 my @libs = ($lib); 108 push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB}; 109 $ENV{PERL5LIB} = join($Config{path_sep}, @libs); 110 unshift @INC, $lib; 111} 112 113END { 114 if( $had5lib ) { 115 $ENV{PERL5LIB} = $old5lib; 116 } 117 else { 118 delete $ENV{PERL5LIB}; 119 } 120} 121 122 123=item B<makefile_name> 124 125 my $makefile = makefile_name; 126 127MakeMaker doesn't always generate 'Makefile'. It returns what it 128should generate. 129 130=cut 131 132sub makefile_name { 133 return $Is_VMS ? 'Descrip.MMS' : 'Makefile'; 134} 135 136=item B<makefile_backup> 137 138 my $makefile_old = makefile_backup; 139 140Returns the name MakeMaker will use for a backup of the current 141Makefile. 142 143=cut 144 145sub makefile_backup { 146 my $makefile = makefile_name; 147 return $Is_VMS ? $makefile : "$makefile.old"; 148} 149 150=item B<make> 151 152 my $make = make; 153 154Returns a good guess at the make to run. 155 156=cut 157 158sub make { 159 my $make = $Config{make}; 160 $make = $ENV{MAKE} if exists $ENV{MAKE}; 161 162 return $make; 163} 164 165=item B<make_run> 166 167 my $make_run = make_run; 168 169Returns the make to run as with make() plus any necessary switches. 170 171=cut 172 173sub make_run { 174 my $make = make; 175 $make .= ' -nologo' if $make eq 'nmake'; 176 177 return $make; 178} 179 180=item B<make_macro> 181 182 my $make_cmd = make_macro($make, $target, %macros); 183 184Returns the command necessary to run $make on the given $target using 185the given %macros. 186 187 my $make_test_verbose = make_macro(make_run(), 'test', 188 TEST_VERBOSE => 1); 189 190This is important because VMS's make utilities have a completely 191different calling convention than Unix or Windows. 192 193%macros is actually a list of tuples, so the order will be preserved. 194 195=cut 196 197sub make_macro { 198 my($make, $target) = (shift, shift); 199 200 my $is_mms = $make =~ /^MM(K|S)/i; 201 202 my $cmd = $make; 203 my $macros = ''; 204 while( my($key,$val) = splice(@_, 0, 2) ) { 205 if( $is_mms ) { 206 $macros .= qq{/macro="$key=$val"}; 207 } 208 else { 209 $macros .= qq{ $key=$val}; 210 } 211 } 212 213 return $is_mms ? "$make$macros $target" : "$make $target $macros"; 214} 215 216=item B<calibrate_mtime> 217 218 my $mtime = calibrate_mtime; 219 220When building on NFS, file modification times can often lose touch 221with reality. This returns the mtime of a file which has just been 222touched. 223 224=cut 225 226sub calibrate_mtime { 227 open(FILE, ">calibrate_mtime.tmp") || die $!; 228 print FILE "foo"; 229 close FILE; 230 my($mtime) = (stat('calibrate_mtime.tmp'))[9]; 231 unlink 'calibrate_mtime.tmp'; 232 return $mtime; 233} 234 235=item B<run> 236 237 my $out = run($command); 238 my @out = run($command); 239 240Runs the given $command as an external program returning at least STDOUT 241as $out. If possible it will return STDOUT and STDERR combined as you 242would expect to see on a screen. 243 244=cut 245 246sub run { 247 my $cmd = shift; 248 249 require ExtUtils::MM; 250 251 # Unix can handle 2>&1 and OS/2 from 5.005_54 up. 252 # This makes our failure diagnostics nicer to read. 253 if( MM->os_flavor_is('Unix') or 254 ($] > 5.00554 and MM->os_flavor_is('OS/2')) 255 ) { 256 return `$cmd 2>&1`; 257 } 258 else { 259 return `$cmd`; 260 } 261} 262 263=back 264 265=head1 AUTHOR 266 267Michael G Schwern <schwern@pobox.com> 268 269=cut 270 2711; 272