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