Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package ExtUtils::MM_Win32; |
2 | ||
3 | use strict; | |
4 | ||
5 | ||
6 | =head1 NAME | |
7 | ||
8 | ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
9 | ||
10 | =head1 SYNOPSIS | |
11 | ||
12 | use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed | |
13 | ||
14 | =head1 DESCRIPTION | |
15 | ||
16 | See ExtUtils::MM_Unix for a documentation of the methods provided | |
17 | there. This package overrides the implementation of these methods, not | |
18 | the semantics. | |
19 | ||
20 | =cut | |
21 | ||
22 | use Config; | |
23 | use File::Basename; | |
24 | use File::Spec; | |
25 | use ExtUtils::MakeMaker qw( neatvalue ); | |
26 | ||
27 | use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE); | |
28 | ||
29 | require ExtUtils::MM_Any; | |
30 | require ExtUtils::MM_Unix; | |
31 | @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); | |
32 | $VERSION = '1.10'; | |
33 | ||
34 | $ENV{EMXSHELL} = 'sh'; # to run `commands` | |
35 | ||
36 | $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; | |
37 | $GCC = 1 if $Config{'cc'} =~ /^gcc/i; | |
38 | $DMAKE = 1 if $Config{'make'} =~ /^dmake/i; | |
39 | $NMAKE = 1 if $Config{'make'} =~ /^nmake/i; | |
40 | ||
41 | ||
42 | =head2 Overridden methods | |
43 | ||
44 | =over 4 | |
45 | ||
46 | =item B<dlsyms> | |
47 | ||
48 | =cut | |
49 | ||
50 | sub dlsyms { | |
51 | my($self,%attribs) = @_; | |
52 | ||
53 | my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; | |
54 | my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; | |
55 | my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; | |
56 | my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; | |
57 | my(@m); | |
58 | ||
59 | if (not $self->{SKIPHASH}{'dynamic'}) { | |
60 | push(@m," | |
61 | $self->{BASEEXT}.def: Makefile.PL | |
62 | ", | |
63 | q! $(PERLRUN) -MExtUtils::Mksymlists \\ | |
64 | -e "Mksymlists('NAME'=>\"!, $self->{NAME}, | |
65 | q!\", 'DLBASE' => '!,$self->{DLBASE}, | |
66 | # The above two lines quoted differently to work around | |
67 | # a bug in the 4DOS/4NT command line interpreter. The visible | |
68 | # result of the bug was files named q('extension_name',) *with the | |
69 | # single quotes and the comma* in the extension build directories. | |
70 | q!', 'DL_FUNCS' => !,neatvalue($funcs), | |
71 | q!, 'FUNCLIST' => !,neatvalue($funclist), | |
72 | q!, 'IMPORTS' => !,neatvalue($imports), | |
73 | q!, 'DL_VARS' => !, neatvalue($vars), q!);" | |
74 | !); | |
75 | } | |
76 | join('',@m); | |
77 | } | |
78 | ||
79 | =item replace_manpage_separator | |
80 | ||
81 | Changes the path separator with . | |
82 | ||
83 | =cut | |
84 | ||
85 | sub replace_manpage_separator { | |
86 | my($self,$man) = @_; | |
87 | $man =~ s,/+,.,g; | |
88 | $man; | |
89 | } | |
90 | ||
91 | ||
92 | =item B<maybe_command> | |
93 | ||
94 | Since Windows has nothing as simple as an executable bit, we check the | |
95 | file extension. | |
96 | ||
97 | The PATHEXT env variable will be used to get a list of extensions that | |
98 | might indicate a command, otherwise .com, .exe, .bat and .cmd will be | |
99 | used by default. | |
100 | ||
101 | =cut | |
102 | ||
103 | sub maybe_command { | |
104 | my($self,$file) = @_; | |
105 | my @e = exists($ENV{'PATHEXT'}) | |
106 | ? split(/;/, $ENV{PATHEXT}) | |
107 | : qw(.com .exe .bat .cmd); | |
108 | my $e = ''; | |
109 | for (@e) { $e .= "\Q$_\E|" } | |
110 | chop $e; | |
111 | # see if file ends in one of the known extensions | |
112 | if ($file =~ /($e)$/i) { | |
113 | return $file if -e $file; | |
114 | } | |
115 | else { | |
116 | for (@e) { | |
117 | return "$file$_" if -e "$file$_"; | |
118 | } | |
119 | } | |
120 | return; | |
121 | } | |
122 | ||
123 | ||
124 | =item B<find_tests> | |
125 | ||
126 | The Win9x shell does not expand globs and I'll play it safe and assume | |
127 | other Windows variants don't either. | |
128 | ||
129 | So we do it for them. | |
130 | ||
131 | =cut | |
132 | ||
133 | sub find_tests { | |
134 | return join(' ', <t\\*.t>); | |
135 | } | |
136 | ||
137 | ||
138 | =item B<init_DIRFILESEP> | |
139 | ||
140 | Using \ for Windows. | |
141 | ||
142 | =cut | |
143 | ||
144 | sub init_DIRFILESEP { | |
145 | my($self) = shift; | |
146 | ||
147 | # The ^ makes sure its not interpreted as an escape in nmake | |
148 | $self->{DIRFILESEP} = $NMAKE ? '^\\' : | |
149 | $DMAKE ? '\\\\' | |
150 | : '\\'; | |
151 | } | |
152 | ||
153 | =item B<init_others> | |
154 | ||
155 | Override some of the Unix specific commands with portable | |
156 | ExtUtils::Command ones. | |
157 | ||
158 | Also provide defaults for LD and AR in case the %Config values aren't | |
159 | set. | |
160 | ||
161 | LDLOADLIBS's default is changed to $Config{libs}. | |
162 | ||
163 | Adjustments are made for Borland's quirks needing -L to come first. | |
164 | ||
165 | =cut | |
166 | ||
167 | sub init_others { | |
168 | my ($self) = @_; | |
169 | ||
170 | # Used in favor of echo because echo won't strip quotes. :( | |
171 | $self->{ECHO} ||= $self->oneliner('print qq{@ARGV}', ['-l']); | |
172 | $self->{ECHO_N} ||= $self->oneliner('print qq{@ARGV}'); | |
173 | ||
174 | $self->{TOUCH} ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch'; | |
175 | $self->{CHMOD} ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod'; | |
176 | $self->{CP} ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp'; | |
177 | $self->{RM_F} ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f'; | |
178 | $self->{RM_RF} ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf'; | |
179 | $self->{MV} ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv'; | |
180 | $self->{NOOP} ||= 'rem'; | |
181 | $self->{TEST_F} ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f'; | |
182 | $self->{DEV_NULL} ||= '> NUL'; | |
183 | ||
184 | $self->{LD} ||= $Config{ld} || 'link'; | |
185 | $self->{AR} ||= $Config{ar} || 'lib'; | |
186 | ||
187 | $self->SUPER::init_others; | |
188 | ||
189 | # Setting SHELL from $Config{sh} can break dmake. Its ok without it. | |
190 | delete $self->{SHELL}; | |
191 | ||
192 | $self->{LDLOADLIBS} ||= $Config{libs}; | |
193 | # -Lfoo must come first for Borland, so we put it in LDDLFLAGS | |
194 | if ($BORLAND) { | |
195 | my $libs = $self->{LDLOADLIBS}; | |
196 | my $libpath = ''; | |
197 | while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) { | |
198 | $libpath .= ' ' if length $libpath; | |
199 | $libpath .= $1; | |
200 | } | |
201 | $self->{LDLOADLIBS} = $libs; | |
202 | $self->{LDDLFLAGS} ||= $Config{lddlflags}; | |
203 | $self->{LDDLFLAGS} .= " $libpath"; | |
204 | } | |
205 | ||
206 | return 1; | |
207 | } | |
208 | ||
209 | ||
210 | =item init_platform (o) | |
211 | ||
212 | Add MM_Win32_VERSION. | |
213 | ||
214 | =item platform_constants (o) | |
215 | ||
216 | =cut | |
217 | ||
218 | sub init_platform { | |
219 | my($self) = shift; | |
220 | ||
221 | $self->{MM_Win32_VERSION} = $VERSION; | |
222 | } | |
223 | ||
224 | sub platform_constants { | |
225 | my($self) = shift; | |
226 | my $make_frag = ''; | |
227 | ||
228 | foreach my $macro (qw(MM_Win32_VERSION)) | |
229 | { | |
230 | next unless defined $self->{$macro}; | |
231 | $make_frag .= "$macro = $self->{$macro}\n"; | |
232 | } | |
233 | ||
234 | return $make_frag; | |
235 | } | |
236 | ||
237 | ||
238 | =item special_targets (o) | |
239 | ||
240 | Add .USESHELL target for dmake. | |
241 | ||
242 | =cut | |
243 | ||
244 | sub special_targets { | |
245 | my($self) = @_; | |
246 | ||
247 | my $make_frag = $self->SUPER::special_targets; | |
248 | ||
249 | $make_frag .= <<'MAKE_FRAG' if $DMAKE; | |
250 | .USESHELL : | |
251 | MAKE_FRAG | |
252 | ||
253 | return $make_frag; | |
254 | } | |
255 | ||
256 | ||
257 | =item static_lib (o) | |
258 | ||
259 | Changes how to run the linker. | |
260 | ||
261 | The rest is duplicate code from MM_Unix. Should move the linker code | |
262 | to its own method. | |
263 | ||
264 | =cut | |
265 | ||
266 | sub static_lib { | |
267 | my($self) = @_; | |
268 | return '' unless $self->has_link_code; | |
269 | ||
270 | my(@m); | |
271 | push(@m, <<'END'); | |
272 | $(INST_STATIC): $(OBJECT) $(MYEXTLIB) blibdirs.ts | |
273 | $(RM_RF) $@ | |
274 | END | |
275 | ||
276 | # If this extension has its own library (eg SDBM_File) | |
277 | # then copy that to $(INST_STATIC) and add $(OBJECT) into it. | |
278 | push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB}; | |
279 | $(CP) $(MYEXTLIB) $@ | |
280 | MAKE_FRAG | |
281 | ||
282 | push @m, | |
283 | q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' | |
284 | : ($GCC ? '-ru $@ $(OBJECT)' | |
285 | : '-out:$@ $(OBJECT)')).q{ | |
286 | $(CHMOD) $(PERM_RWX) $@ | |
287 | $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld | |
288 | }; | |
289 | ||
290 | # Old mechanism - still available: | |
291 | push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; | |
292 | $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs | |
293 | MAKE_FRAG | |
294 | ||
295 | join('', @m); | |
296 | } | |
297 | ||
298 | ||
299 | =item dynamic_lib (o) | |
300 | ||
301 | Complicated stuff for Win32 that I don't understand. :( | |
302 | ||
303 | =cut | |
304 | ||
305 | sub dynamic_lib { | |
306 | my($self, %attribs) = @_; | |
307 | return '' unless $self->needs_linking(); #might be because of a subdir | |
308 | ||
309 | return '' unless $self->has_link_code; | |
310 | ||
311 | my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); | |
312 | my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
313 | my($ldfrom) = '$(LDFROM)'; | |
314 | my(@m); | |
315 | ||
316 | # one thing for GCC/Mingw32: | |
317 | # we try to overcome non-relocateable-DLL problems by generating | |
318 | # a (hopefully unique) image-base from the dll's name | |
319 | # -- BKS, 10-19-1999 | |
320 | if ($GCC) { | |
321 | my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT}; | |
322 | $dllname =~ /(....)(.{0,4})/; | |
323 | my $baseaddr = unpack("n", $1 ^ $2); | |
324 | $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr); | |
325 | } | |
326 | ||
327 | push(@m,' | |
328 | # This section creates the dynamically loadable $(INST_DYNAMIC) | |
329 | # from $(OBJECT) and possibly $(MYEXTLIB). | |
330 | OTHERLDFLAGS = '.$otherldflags.' | |
331 | INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' | |
332 | ||
333 | $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) blibdirs.ts $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) | |
334 | '); | |
335 | if ($GCC) { | |
336 | push(@m, | |
337 | q{ dlltool --def $(EXPORT_LIST) --output-exp dll.exp | |
338 | $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp | |
339 | dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp | |
340 | $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp }); | |
341 | } elsif ($BORLAND) { | |
342 | push(@m, | |
343 | q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,} | |
344 | .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) } | |
345 | .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)} | |
346 | : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) } | |
347 | .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))}) | |
348 | .q{,$(RESFILES)}); | |
349 | } else { # VC | |
350 | push(@m, | |
351 | q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } | |
352 | .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}); | |
353 | } | |
354 | push @m, ' | |
355 | $(CHMOD) $(PERM_RWX) $@ | |
356 | '; | |
357 | ||
358 | join('',@m); | |
359 | } | |
360 | ||
361 | =item clean | |
362 | ||
363 | Clean out some extra dll.{base,exp} files which might be generated by | |
364 | gcc. Otherwise, take out all *.pdb files. | |
365 | ||
366 | =cut | |
367 | ||
368 | sub clean | |
369 | { | |
370 | my ($self) = shift; | |
371 | my $s = $self->SUPER::clean(@_); | |
372 | my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb'; | |
373 | $s .= <<END; | |
374 | clean :: | |
375 | -\$(RM_F) $clean | |
376 | ||
377 | END | |
378 | return $s; | |
379 | } | |
380 | ||
381 | =item init_linker | |
382 | ||
383 | =cut | |
384 | ||
385 | sub init_linker { | |
386 | my $self = shift; | |
387 | ||
388 | $self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}"; | |
389 | $self->{PERL_ARCHIVE_AFTER} = ''; | |
390 | $self->{EXPORT_LIST} = '$(BASEEXT).def'; | |
391 | } | |
392 | ||
393 | ||
394 | =item perl_script | |
395 | ||
396 | Checks for the perl program under several common perl extensions. | |
397 | ||
398 | =cut | |
399 | ||
400 | sub perl_script { | |
401 | my($self,$file) = @_; | |
402 | return $file if -r $file && -f _; | |
403 | return "$file.pl" if -r "$file.pl" && -f _; | |
404 | return "$file.plx" if -r "$file.plx" && -f _; | |
405 | return "$file.bat" if -r "$file.bat" && -f _; | |
406 | return; | |
407 | } | |
408 | ||
409 | ||
410 | =item xs_o (o) | |
411 | ||
412 | This target is stubbed out. Not sure why. | |
413 | ||
414 | =cut | |
415 | ||
416 | sub xs_o { | |
417 | return '' | |
418 | } | |
419 | ||
420 | ||
421 | =item pasthru (o) | |
422 | ||
423 | All we send is -nologo to nmake to prevent it from printing its damned | |
424 | banner. | |
425 | ||
426 | =cut | |
427 | ||
428 | sub pasthru { | |
429 | my($self) = shift; | |
430 | return "PASTHRU = " . ($NMAKE ? "-nologo" : ""); | |
431 | } | |
432 | ||
433 | ||
434 | =item oneliner (o) | |
435 | ||
436 | These are based on what command.com does on Win98. They may be wrong | |
437 | for other Windows shells, I don't know. | |
438 | ||
439 | =cut | |
440 | ||
441 | sub oneliner { | |
442 | my($self, $cmd, $switches) = @_; | |
443 | $switches = [] unless defined $switches; | |
444 | ||
445 | # Strip leading and trailing newlines | |
446 | $cmd =~ s{^\n+}{}; | |
447 | $cmd =~ s{\n+$}{}; | |
448 | ||
449 | $cmd = $self->quote_literal($cmd); | |
450 | $cmd = $self->escape_newlines($cmd); | |
451 | ||
452 | $switches = join ' ', @$switches; | |
453 | ||
454 | return qq{\$(ABSPERLRUN) $switches -e $cmd}; | |
455 | } | |
456 | ||
457 | ||
458 | sub quote_literal { | |
459 | my($self, $text) = @_; | |
460 | ||
461 | # I don't know if this is correct, but it seems to work on | |
462 | # Win98's command.com | |
463 | $text =~ s{"}{\\"}g; | |
464 | ||
465 | # dmake eats '{' inside double quotes and leaves alone { outside double | |
466 | # quotes; however it transforms {{ into { either inside and outside double | |
467 | # quotes. It also translates }} into }. The escaping below is not | |
468 | # 100% correct. | |
469 | if( $DMAKE ) { | |
470 | $text =~ s/{/{{/g; | |
471 | $text =~ s/}}/}}}/g; | |
472 | } | |
473 | ||
474 | return qq{"$text"}; | |
475 | } | |
476 | ||
477 | ||
478 | sub escape_newlines { | |
479 | my($self, $text) = @_; | |
480 | ||
481 | # Escape newlines | |
482 | $text =~ s{\n}{\\\n}g; | |
483 | ||
484 | return $text; | |
485 | } | |
486 | ||
487 | ||
488 | =item max_exec_len | |
489 | ||
490 | nmake 1.50 limits command length to 2048 characters. | |
491 | ||
492 | =cut | |
493 | ||
494 | sub max_exec_len { | |
495 | my $self = shift; | |
496 | ||
497 | return $self->{_MAX_EXEC_LEN} ||= 2 * 1024; | |
498 | } | |
499 | ||
500 | ||
501 | =item os_flavor | |
502 | ||
503 | Windows is Win32. | |
504 | ||
505 | =cut | |
506 | ||
507 | sub os_flavor { | |
508 | return('Win32'); | |
509 | } | |
510 | ||
511 | ||
512 | 1; | |
513 | __END__ | |
514 | ||
515 | =back | |
516 | ||
517 | =cut | |
518 | ||
519 |