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