This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
be9538e6d37888d894ef64bfc9219c417768e7ca
[perl5.git] / lib / ExtUtils / MM_Win32.pm
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.09';
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 a default for AR in case the %Config values aren't
159 set. LD is now set in init_linker().
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}    ||= '$(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
184
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) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
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     push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
296     join('', @m);
297 }
298
299
300 =item dynamic_lib (o)
301
302 Complicated stuff for Win32 that I don't understand. :(
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
312     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
313     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
314     my($ldfrom) = '$(LDFROM)';
315     my(@m);
316
317 # one thing for GCC/Mingw32:
318 # we try to overcome non-relocateable-DLL problems by generating
319 #    a (hopefully unique) image-base from the dll's name
320 # -- BKS, 10-19-1999
321     if ($GCC) { 
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
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
334 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
335 ');
336     if ($GCC) {
337       push(@m,  
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
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 });
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)});
354     }
355     push @m, '
356         $(CHMOD) $(PERM_RWX) $@
357 ';
358
359     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
360     join('',@m);
361 }
362
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
370 sub clean
371 {
372     my ($self) = shift;
373     my $s = $self->SUPER::clean(@_);
374     my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
375     $s .= <<END;
376 clean ::
377         -\$(RM_F) $clean
378
379 END
380     return $s;
381 }
382
383 =item init_linker
384
385 Unless previosuly set initializes LD to be the linker specified in Config and falls back
386 to the standard Win32 linker 'link'.
387
388 =cut
389
390 sub init_linker {
391     my $self = shift;
392
393     $self->{LD}     ||= $Config{ld} || 'link';
394     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
395     $self->{PERL_ARCHIVE_AFTER} = '';
396     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
397 }
398
399
400 =item perl_script
401
402 Checks for the perl program under several common perl extensions.
403
404 =cut
405
406 sub perl_script {
407     my($self,$file) = @_;
408     return $file if -r $file && -f _;
409     return "$file.pl"  if -r "$file.pl" && -f _;
410     return "$file.plx" if -r "$file.plx" && -f _;
411     return "$file.bat" if -r "$file.bat" && -f _;
412     return;
413 }
414
415
416 =item xs_o (o)
417
418 This target is stubbed out.  Not sure why.
419
420 =cut
421
422 sub xs_o {
423     return ''
424 }
425
426
427 =item pasthru (o)
428
429 All we send is -nologo to nmake to prevent it from printing its damned
430 banner.
431
432 =cut
433
434 sub pasthru {
435     my($self) = shift;
436     return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
437 }
438
439
440 =item oneliner (o)
441
442 These are based on what command.com does on Win98.  They may be wrong
443 for other Windows shells, I don't know.
444
445 =cut
446
447 sub oneliner {
448     my($self, $cmd, $switches) = @_;
449     $switches = [] unless defined $switches;
450
451     # Strip leading and trailing newlines
452     $cmd =~ s{^\n+}{};
453     $cmd =~ s{\n+$}{};
454
455     $cmd = $self->quote_literal($cmd);
456     $cmd = $self->escape_newlines($cmd);
457
458     $switches = join ' ', @$switches;
459
460     return qq{\$(PERLRUN) $switches -e $cmd};
461 }
462
463
464 sub quote_literal {
465     my($self, $text) = @_;
466
467     # I don't know if this is correct, but it seems to work on
468     # Win98's command.com
469     $text =~ s{"}{\\"}g;
470
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
480     return qq{"$text"};
481 }
482
483
484 sub escape_newlines {
485     my($self, $text) = @_;
486
487     # Escape newlines
488     $text =~ s{\n}{\\\n}g;
489
490     return $text;
491 }
492
493
494 =item max_exec_len
495
496 nmake 1.50 limits command length to 2048 characters.
497
498 =cut
499
500 sub max_exec_len {
501     my $self = shift;
502
503     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
504 }
505
506
507 =item os_flavor
508
509 Windows is Win32.
510
511 =cut
512
513 sub os_flavor {
514     return('Win32');
515 }
516
517
518 1;
519 __END__
520
521 =back
522
523 =cut 
524
525