t/lib/MakeMaker/Test/Utils.pm

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