Prepare the next release schedule
[perl.git] / cpan / ExtUtils-MakeMaker / 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 _sprintf562);
26
27 require ExtUtils::MM_Any;
28 require ExtUtils::MM_Unix;
29 our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
30 our $VERSION = '7.34';
31 $VERSION = eval $VERSION;
32
33 $ENV{EMXSHELL} = 'sh'; # to run `commands`
34
35 my ( $BORLAND, $GCC, $MSVC ) = _identify_compiler_environment( \%Config );
36
37 sub _identify_compiler_environment {
38         my ( $config ) = @_;
39
40         my $BORLAND = $config->{cc} =~ /\bbcc/i ? 1 : 0;
41         my $GCC     = $config->{cc} =~ /\bgcc\b/i ? 1 : 0;
42         my $MSVC    = $config->{cc} =~ /\b(?:cl|icl)/i ? 1 : 0; # MSVC can come as clarm.exe, icl=Intel C
43
44         return ( $BORLAND, $GCC, $MSVC );
45 }
46
47
48 =head2 Overridden methods
49
50 =over 4
51
52 =item B<dlsyms>
53
54 =cut
55
56 sub dlsyms {
57     my($self,%attribs) = @_;
58     return '' if $self->{SKIPHASH}{'dynamic'};
59     $self->xs_dlsyms_iterator(\%attribs);
60 }
61
62 =item xs_dlsyms_ext
63
64 On Win32, is C<.def>.
65
66 =cut
67
68 sub xs_dlsyms_ext {
69     '.def';
70 }
71
72 =item replace_manpage_separator
73
74 Changes the path separator with .
75
76 =cut
77
78 sub replace_manpage_separator {
79     my($self,$man) = @_;
80     $man =~ s,/+,.,g;
81     $man;
82 }
83
84
85 =item B<maybe_command>
86
87 Since Windows has nothing as simple as an executable bit, we check the
88 file extension.
89
90 The PATHEXT env variable will be used to get a list of extensions that
91 might indicate a command, otherwise .com, .exe, .bat and .cmd will be
92 used by default.
93
94 =cut
95
96 sub maybe_command {
97     my($self,$file) = @_;
98     my @e = exists($ENV{'PATHEXT'})
99           ? split(/;/, $ENV{PATHEXT})
100           : qw(.com .exe .bat .cmd);
101     my $e = '';
102     for (@e) { $e .= "\Q$_\E|" }
103     chop $e;
104     # see if file ends in one of the known extensions
105     if ($file =~ /($e)$/i) {
106         return $file if -e $file;
107     }
108     else {
109         for (@e) {
110             return "$file$_" if -e "$file$_";
111         }
112     }
113     return;
114 }
115
116
117 =item B<init_DIRFILESEP>
118
119 Using \ for Windows, except for "gmake" where it is /.
120
121 =cut
122
123 sub init_DIRFILESEP {
124     my($self) = shift;
125
126     # The ^ makes sure its not interpreted as an escape in nmake
127     $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' :
128                           $self->is_make_type('dmake') ? '\\\\' :
129                           $self->is_make_type('gmake') ? '/'
130                                                        : '\\';
131 }
132
133 =item init_tools
134
135 Override some of the slower, portable commands with Windows specific ones.
136
137 =cut
138
139 sub init_tools {
140     my ($self) = @_;
141
142     $self->{NOOP}     ||= 'rem';
143     $self->{DEV_NULL} ||= '> NUL';
144
145     $self->{FIXIN}    ||= $self->{PERL_CORE} ?
146       "\$(PERLRUN) $self->{PERL_SRC}\\win32\\bin\\pl2bat.pl" :
147       'pl2bat.bat';
148
149     $self->SUPER::init_tools;
150
151     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
152     delete $self->{SHELL};
153
154     return;
155 }
156
157
158 =item init_others
159
160 Override the default link and compile tools.
161
162 LDLOADLIBS's default is changed to $Config{libs}.
163
164 Adjustments are made for Borland's quirks needing -L to come first.
165
166 =cut
167
168 sub init_others {
169     my $self = shift;
170
171     $self->{LD}     ||= 'link';
172     $self->{AR}     ||= 'lib';
173
174     $self->SUPER::init_others;
175
176     $self->{LDLOADLIBS} ||= $Config{libs};
177     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
178     if ($BORLAND) {
179         my $libs = $self->{LDLOADLIBS};
180         my $libpath = '';
181         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
182             $libpath .= ' ' if length $libpath;
183             $libpath .= $1;
184         }
185         $self->{LDLOADLIBS} = $libs;
186         $self->{LDDLFLAGS} ||= $Config{lddlflags};
187         $self->{LDDLFLAGS} .= " $libpath";
188     }
189
190     return;
191 }
192
193
194 =item init_platform
195
196 Add MM_Win32_VERSION.
197
198 =item platform_constants
199
200 =cut
201
202 sub init_platform {
203     my($self) = shift;
204
205     $self->{MM_Win32_VERSION} = $VERSION;
206
207     return;
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 =item specify_shell
224
225 Set SHELL to $ENV{COMSPEC} only if make is type 'gmake'.
226
227 =cut
228
229 sub specify_shell {
230     my $self = shift;
231     return '' unless $self->is_make_type('gmake');
232     "\nSHELL = $ENV{COMSPEC}\n";
233 }
234
235 =item constants
236
237 Add MAXLINELENGTH for dmake before all the constants are output.
238
239 =cut
240
241 sub constants {
242     my $self = shift;
243
244     my $make_text = $self->SUPER::constants;
245     return $make_text unless $self->is_make_type('dmake');
246
247     # dmake won't read any single "line" (even those with escaped newlines)
248     # larger than a certain size which can be as small as 8k.  PM_TO_BLIB
249     # on large modules like DateTime::TimeZone can create lines over 32k.
250     # So we'll crank it up to a <ironic>WHOPPING</ironic> 64k.
251     #
252     # This has to come here before all the constants and not in
253     # platform_constants which is after constants.
254     my $size = $self->{MAXLINELENGTH} || 800000;
255     my $prefix = qq{
256 # Get dmake to read long commands like PM_TO_BLIB
257 MAXLINELENGTH = $size
258
259 };
260
261     return $prefix . $make_text;
262 }
263
264
265 =item special_targets
266
267 Add .USESHELL target for dmake.
268
269 =cut
270
271 sub special_targets {
272     my($self) = @_;
273
274     my $make_frag = $self->SUPER::special_targets;
275
276     $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
277 .USESHELL :
278 MAKE_FRAG
279
280     return $make_frag;
281 }
282
283 =item static_lib_pure_cmd
284
285 Defines how to run the archive utility
286
287 =cut
288
289 sub static_lib_pure_cmd {
290     my ($self, $from) = @_;
291     $from =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND;
292     sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $from
293                           : ($GCC ? '-ru $@ ' . $from
294                                   : '-out:$@ ' . $from));
295 }
296
297 =item dynamic_lib
298
299 Methods are overridden here: not dynamic_lib itself, but the utility
300 ones that do the OS-specific work.
301
302 =cut
303
304 sub xs_make_dynamic_lib {
305     my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_;
306     my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)'."\n", $to, $from, $todir, $exportlist;
307     if ($GCC) {
308       # per https://rt.cpan.org/Ticket/Display.html?id=78395 no longer
309       # uses dlltool - relies on post 2002 MinGW
310       #                             1            2
311       push @m, _sprintf562 <<'EOF', $exportlist, $ldfrom;
312         $(LD) %1$s -o $@ $(LDDLFLAGS) %2$s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -Wl,--enable-auto-image-base
313 EOF
314     } elsif ($BORLAND) {
315       my $ldargs = $self->is_make_type('dmake')
316           ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),}
317           : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) $(subst /,\,$(MYEXTLIB)),};
318       my $subbed;
319       if ($exportlist eq '$(EXPORT_LIST)') {
320           $subbed = $self->is_make_type('dmake')
321               ? q{$(EXPORT_LIST:s,/,\,)}
322               : q{$(subst /,\,$(EXPORT_LIST))};
323       } else {
324             # in XSMULTI, exportlist is per-XS, so have to sub in perl not make
325           ($subbed = $exportlist) =~ s#/#\\#g;
326       }
327       push @m, sprintf <<'EOF', $ldfrom, $ldargs . $subbed;
328         $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) %s,$@,,%s,$(RESFILES)
329 EOF
330     } else {    # VC
331       push @m, sprintf <<'EOF', $ldfrom, $exportlist;
332         $(LD) -out:$@ $(LDDLFLAGS) %s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:%s
333 EOF
334       # Embed the manifest file if it exists
335       push(@m, q{       if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
336         if exist $@.manifest del $@.manifest});
337     }
338     push @m, "\n\t\$(CHMOD) \$(PERM_RWX) \$\@\n";
339
340     join '', @m;
341 }
342
343 sub xs_dynamic_lib_macros {
344     my ($self, $attribs) = @_;
345     my $otherldflags = $attribs->{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
346     my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || "";
347     sprintf <<'EOF', $otherldflags, $inst_dynamic_dep;
348 # This section creates the dynamically loadable objects from relevant
349 # objects and possibly $(MYEXTLIB).
350 OTHERLDFLAGS = %s
351 INST_DYNAMIC_DEP = %s
352 EOF
353 }
354
355 =item extra_clean_files
356
357 Clean out some extra dll.{base,exp} files which might be generated by
358 gcc.  Otherwise, take out all *.pdb files.
359
360 =cut
361
362 sub extra_clean_files {
363     my $self = shift;
364
365     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
366 }
367
368 =item init_linker
369
370 =cut
371
372 sub init_linker {
373     my $self = shift;
374
375     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
376     $self->{PERL_ARCHIVEDEP}    = "\$(PERL_INCDEP)\\$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 sub can_dep_space {
398     my $self = shift;
399     1; # with Win32::GetShortPathName
400 }
401
402 =item quote_dep
403
404 =cut
405
406 sub quote_dep {
407     my ($self, $arg) = @_;
408     if ($arg =~ / / and not $self->is_make_type('gmake')) {
409         require Win32;
410         $arg = Win32::GetShortPathName($arg);
411         die <<EOF if not defined $arg or $arg =~ / /;
412 Tried to use make dependency with space for non-GNU make:
413   '$arg'
414 Fallback to short pathname failed.
415 EOF
416         return $arg;
417     }
418     return $self->SUPER::quote_dep($arg);
419 }
420
421
422 =item xs_obj_opt
423
424 Override to fixup -o flags for MSVC.
425
426 =cut
427
428 sub xs_obj_opt {
429     my ($self, $output_file) = @_;
430     ($MSVC ? "/Fo" : "-o ") . $output_file;
431 }
432
433
434 =item pasthru
435
436 All we send is -nologo to nmake to prevent it from printing its damned
437 banner.
438
439 =cut
440
441 sub pasthru {
442     my($self) = shift;
443     my $old = $self->SUPER::pasthru;
444     return $old unless $self->is_make_type('nmake');
445     $old =~ s/(PASTHRU\s*=\s*)/$1 -nologo /;
446     $old;
447 }
448
449
450 =item arch_check (override)
451
452 Normalize all arguments for consistency of comparison.
453
454 =cut
455
456 sub arch_check {
457     my $self = shift;
458
459     # Win32 is an XS module, minperl won't have it.
460     # arch_check() is not critical, so just fake it.
461     return 1 unless $self->can_load_xs;
462     return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
463 }
464
465 sub _normalize_path_name {
466     my $self = shift;
467     my $file = shift;
468
469     require Win32;
470     my $short = Win32::GetShortPathName($file);
471     return defined $short ? lc $short : lc $file;
472 }
473
474
475 =item oneliner
476
477 These are based on what command.com does on Win98.  They may be wrong
478 for other Windows shells, I don't know.
479
480 =cut
481
482 sub oneliner {
483     my($self, $cmd, $switches) = @_;
484     $switches = [] unless defined $switches;
485
486     # Strip leading and trailing newlines
487     $cmd =~ s{^\n+}{};
488     $cmd =~ s{\n+$}{};
489
490     $cmd = $self->quote_literal($cmd);
491     $cmd = $self->escape_newlines($cmd);
492
493     $switches = join ' ', @$switches;
494
495     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
496 }
497
498
499 sub quote_literal {
500     my($self, $text, $opts) = @_;
501     $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
502
503     # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
504
505     # Apply the Microsoft C/C++ parsing rules
506     $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
507     $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
508     $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
509     $text = qq{"$text"} if $text =~ /[ \t]/;
510
511     # Apply the Command Prompt parsing rules (cmd.exe)
512     my @text = split /("[^"]*")/, $text;
513     # We should also escape parentheses, but it breaks one-liners containing
514     # $(MACRO)s in makefiles.
515     s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
516     $text = join('', @text);
517
518     # dmake expands {{ to { and }} to }.
519     if( $self->is_make_type('dmake') ) {
520         $text =~ s/{/{{/g;
521         $text =~ s/}/}}/g;
522     }
523
524     $text = $opts->{allow_variables}
525       ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
526
527     return $text;
528 }
529
530
531 sub escape_newlines {
532     my($self, $text) = @_;
533
534     # Escape newlines
535     $text =~ s{\n}{\\\n}g;
536
537     return $text;
538 }
539
540
541 =item cd
542
543 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
544 wants:
545
546     cd dir1\dir2
547     command
548     another_command
549     cd ..\..
550
551 =cut
552
553 sub cd {
554     my($self, $dir, @cmds) = @_;
555
556     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
557
558     my $cmd = join "\n\t", map "$_", @cmds;
559
560     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
561
562     # No leading tab and no trailing newline makes for easier embedding.
563     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
564 cd %s
565         %s
566         cd %s
567 MAKE_FRAG
568
569     chomp $make_frag;
570
571     return $make_frag;
572 }
573
574
575 =item max_exec_len
576
577 nmake 1.50 limits command length to 2048 characters.
578
579 =cut
580
581 sub max_exec_len {
582     my $self = shift;
583
584     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
585 }
586
587
588 =item os_flavor
589
590 Windows is Win32.
591
592 =cut
593
594 sub os_flavor {
595     return('Win32');
596 }
597
598
599 =item cflags
600
601 Defines the PERLDLL symbol if we are configured for static building since all
602 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
603 defined.
604
605 =cut
606
607 sub cflags {
608     my($self,$libperl)=@_;
609     return $self->{CFLAGS} if $self->{CFLAGS};
610     return '' unless $self->needs_linking();
611
612     my $base = $self->SUPER::cflags($libperl);
613     foreach (split /\n/, $base) {
614         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
615     };
616     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
617
618     return $self->{CFLAGS} = qq{
619 CCFLAGS = $self->{CCFLAGS}
620 OPTIMIZE = $self->{OPTIMIZE}
621 PERLTYPE = $self->{PERLTYPE}
622 };
623
624 }
625
626 =item make_type
627
628 Returns a suitable string describing the type of makefile being written.
629
630 =cut
631
632 sub make_type {
633     my ($self) = @_;
634     my $make = $self->make;
635     $make = +( File::Spec->splitpath( $make ) )[-1];
636     $make =~ s!\.exe$!!i;
637     if ( $make =~ m![^A-Z0-9]!i ) {
638       ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make;
639     }
640     return "$make-style";
641 }
642
643 1;
644 __END__
645
646 =back