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.01;
  13
  14 @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup
  15              make make_run make_macro
  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 =head1 DESCRIPTION
  40
  41 A consolidation of little utility functions used through out the
  42 MakeMaker test suite.
  43
  44 =head2 Functions
  45
  46 The following are exported by default.
  47
  48 =over 4
  49
  50 =item B<which_perl>
  51
  52   my $perl = which_perl;
  53
  54 Returns a path to perl which is safe to use in a command line, no
  55 matter where you chdir to.
  56
  57 =cut
  58
  59 sub which_perl {
  60     my $perl = $^X;
  61     $perl ||= 'perl';
  62
  63     # VMS should have 'perl' aliased properly
  64     return $perl if $Is_VMS;
  65
  66     $perl = File::Spec->rel2abs( $perl );
  67
  68     unless( -x $perl ) {
  69         # $^X was probably 'perl'
  70         foreach my $path (File::Spec->path) {
  71             $perl = File::Spec->catfile($path, $^X);
  72             last if -x $perl;
  73         }
  74     }
  75
  76     return $perl;
  77 }
  78
  79 =item B<perl_lib>
  80
  81   perl_lib;
  82
  83 Sets up environment variables so perl can find its libraries.
  84
  85 =cut
  86
  87 my $old5lib = $ENV{PERL5LIB};
  88 my $had5lib = exists $ENV{PERL5LIB};
  89 sub perl_lib {
  90                                # perl-src/lib/ExtUtils/t/Foo
  91     my $lib =  $ENV{PERL_CORE} ? qq{../../../lib}
  92                                # ExtUtils-MakeMaker/t/Foo
  93                                : qq{../blib/lib};
  94     $lib = File::Spec->rel2abs($lib);
  95     my @libs = ($lib);
  96     push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
  97     $ENV{PERL5LIB} = join($Config{path_sep}, @libs);
  98     unshift @INC, $lib;
  99 }
 100
 101 END {
 102     if( $had5lib ) {
 103         $ENV{PERL5LIB} = $old5lib;
 104     }
 105     else {
 106         delete $ENV{PERL5LIB};
 107     }
 108 }
 109
 110
 111 =item B<makefile_name>
 112
 113   my $makefile = makefile_name;
 114
 115 MakeMaker doesn't always generate 'Makefile'.  It returns what it
 116 should generate.
 117
 118 =cut
 119
 120 sub makefile_name {
 121     return $Is_VMS ? 'Descrip.MMS' : 'Makefile';
 122 }
 123
 124 =item B<makefile_backup>
 125
 126   my $makefile_old = makefile_backup;
 127
 128 Returns the name MakeMaker will use for a backup of the current
 129 Makefile.
 130
 131 =cut
 132
 133 sub makefile_backup {
 134     my $makefile = makefile_name;
 135     return $Is_VMS ? $makefile : "$makefile.old";
 136 }
 137
 138 =item B<make>
 139
 140   my $make = make;
 141
 142 Returns a good guess at the make to run.
 143
 144 =cut
 145
 146 sub make {
 147     my $make = $Config{make};
 148     $make = $ENV{MAKE} if exists $ENV{MAKE};
 149
 150     return $make;
 151 }
 152
 153 =item B<make_run>
 154
 155   my $make_run = make_run;
 156
 157 Returns the make to run as with make() plus any necessary switches.
 158
 159 =cut
 160
 161 sub make_run {
 162     my $make = make;
 163     $make .= ' -nologo' if $make eq 'nmake';
 164
 165     return $make;
 166 }
 167
 168 =item B<make_macro>
 169
 170     my $make_cmd = make_macro($make, $target, %macros);
 171
 172 Returns the command necessary to run $make on the given $target using
 173 the given %macros.
 174
 175   my $make_test_verbose = make_macro(make_run(), 'test',
 176                                      TEST_VERBOSE => 1);
 177
 178 This is important because VMS's make utilities have a completely
 179 different calling convention than Unix or Windows.
 180
 181 %macros is actually a list of tuples, so the order will be preserved.
 182
 183 =cut
 184
 185 sub make_macro {
 186     my($make, $target) = (shift, shift);
 187
 188     my $is_mms = $make =~ /^MM(K|S)/i;
 189
 190     my $cmd = $make;
 191     my $macros = '';
 192     while( my($key,$val) = splice(@_, 0, 2) ) {
 193         if( $is_mms ) {
 194             $macros .= qq{/macro="$key=$val"};
 195         }
 196         else {
 197             $macros .= qq{ $key=$val};
 198         }
 199     }
 200
 201     return $is_mms ? "$make$macros $target" : "$make $target $macros";
 202 }
 203
 204 =back
 205
 206 =head1 AUTHOR
 207
 208 Michael G Schwern <schwern@pobox.com>
 209
 210 =cut
 211
 212 1;