Commit | Line | Data |
f6d6199c |
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 | |
80a5d8e7 |
12 | $VERSION = 0.02; |
f6d6199c |
13 | |
14 | @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup |
80a5d8e7 |
15 | make make_run make_macro calibrate_mtime |
f6d6199c |
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 | |
80a5d8e7 |
39 | my $mtime = calibrate_mtime; |
40 | |
f6d6199c |
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 | |
80a5d8e7 |
68 | $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i; |
f6d6199c |
69 | |
80a5d8e7 |
70 | my $perlpath = File::Spec->rel2abs( $perl ); |
71 | unless( -x $perlpath ) { |
f6d6199c |
72 | # $^X was probably 'perl' |
80a5d8e7 |
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 | |
f6d6199c |
79 | foreach my $path (File::Spec->path) { |
80a5d8e7 |
80 | $perlpath = File::Spec->catfile($path, $perl); |
81 | last if -x $perlpath; |
f6d6199c |
82 | } |
83 | } |
84 | |
80a5d8e7 |
85 | return $perlpath; |
f6d6199c |
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 | |
80a5d8e7 |
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 | |
f6d6199c |
232 | =back |
233 | |
234 | =head1 AUTHOR |
235 | |
236 | Michael G Schwern <schwern@pobox.com> |
237 | |
238 | =cut |
239 | |
240 | 1; |