This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update ExtUtils-MakeMaker to CPAN version 6.72
[perl5.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 );
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.72';
31
32 $ENV{EMXSHELL} = 'sh'; # to run `commands`
33
34 my ( $BORLAND, $GCC, $DLLTOOL ) = _identify_compiler_environment( \%Config );
35
36 sub _identify_compiler_environment {
37         my ( $config ) = @_;
38
39         my $BORLAND = $config->{cc} =~ /^bcc/i ? 1 : 0;
40         my $GCC     = $config->{cc} =~ /\bgcc\b/i ? 1 : 0;
41         my $DLLTOOL = $config->{dlltool} || 'dlltool';
42
43         return ( $BORLAND, $GCC, $DLLTOOL );
44 }
45
46
47 =head2 Overridden methods
48
49 =over 4
50
51 =item B<dlsyms>
52
53 =cut
54
55 sub dlsyms {
56     my($self,%attribs) = @_;
57
58     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
59     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
60     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
61     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
62     my(@m);
63
64     if (not $self->{SKIPHASH}{'dynamic'}) {
65         push(@m,"
66 $self->{BASEEXT}.def: Makefile.PL
67 ",
68      q! $(PERLRUN) -MExtUtils::Mksymlists \\
69      -e "Mksymlists('NAME'=>\"!, $self->{NAME},
70      q!\", 'DLBASE' => '!,$self->{DLBASE},
71      # The above two lines quoted differently to work around
72      # a bug in the 4DOS/4NT command line interpreter.  The visible
73      # result of the bug was files named q('extension_name',) *with the
74      # single quotes and the comma* in the extension build directories.
75      q!', 'DL_FUNCS' => !,neatvalue($funcs),
76      q!, 'FUNCLIST' => !,neatvalue($funclist),
77      q!, 'IMPORTS' => !,neatvalue($imports),
78      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
79 !);
80     }
81     join('',@m);
82 }
83
84 =item replace_manpage_separator
85
86 Changes the path separator with .
87
88 =cut
89
90 sub replace_manpage_separator {
91     my($self,$man) = @_;
92     $man =~ s,/+,.,g;
93     $man;
94 }
95
96
97 =item B<maybe_command>
98
99 Since Windows has nothing as simple as an executable bit, we check the
100 file extension.
101
102 The PATHEXT env variable will be used to get a list of extensions that
103 might indicate a command, otherwise .com, .exe, .bat and .cmd will be
104 used by default.
105
106 =cut
107
108 sub maybe_command {
109     my($self,$file) = @_;
110     my @e = exists($ENV{'PATHEXT'})
111           ? split(/;/, $ENV{PATHEXT})
112           : qw(.com .exe .bat .cmd);
113     my $e = '';
114     for (@e) { $e .= "\Q$_\E|" }
115     chop $e;
116     # see if file ends in one of the known extensions
117     if ($file =~ /($e)$/i) {
118         return $file if -e $file;
119     }
120     else {
121         for (@e) {
122             return "$file$_" if -e "$file$_";
123         }
124     }
125     return;
126 }
127
128
129 =item B<init_DIRFILESEP>
130
131 Using \ for Windows.
132
133 =cut
134
135 sub init_DIRFILESEP {
136     my($self) = shift;
137
138     # The ^ makes sure its not interpreted as an escape in nmake
139     $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' :
140                           $self->is_make_type('dmake') ? '\\\\'
141                                                        : '\\';
142 }
143
144 =item init_tools
145
146 Override some of the slower, portable commands with Windows specific ones.
147
148 =cut
149
150 sub init_tools {
151     my ($self) = @_;
152
153     $self->{NOOP}     ||= 'rem';
154     $self->{DEV_NULL} ||= '> NUL';
155
156     $self->{FIXIN}    ||= $self->{PERL_CORE} ?
157       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" :
158       'pl2bat.bat';
159
160     $self->SUPER::init_tools;
161
162     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
163     delete $self->{SHELL};
164
165     return;
166 }
167
168
169 =item init_others
170
171 Override the default link and compile tools.
172
173 LDLOADLIBS's default is changed to $Config{libs}.
174
175 Adjustments are made for Borland's quirks needing -L to come first.
176
177 =cut
178
179 sub init_others {
180     my $self = shift;
181
182     $self->{LD}     ||= 'link';
183     $self->{AR}     ||= 'lib';
184
185     $self->SUPER::init_others;
186
187     $self->{LDLOADLIBS} ||= $Config{libs};
188     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
189     if ($BORLAND) {
190         my $libs = $self->{LDLOADLIBS};
191         my $libpath = '';
192         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
193             $libpath .= ' ' if length $libpath;
194             $libpath .= $1;
195         }
196         $self->{LDLOADLIBS} = $libs;
197         $self->{LDDLFLAGS} ||= $Config{lddlflags};
198         $self->{LDDLFLAGS} .= " $libpath";
199     }
200
201     return;
202 }
203
204
205 =item init_platform
206
207 Add MM_Win32_VERSION.
208
209 =item platform_constants
210
211 =cut
212
213 sub init_platform {
214     my($self) = shift;
215
216     $self->{MM_Win32_VERSION} = $VERSION;
217
218     return;
219 }
220
221 sub platform_constants {
222     my($self) = shift;
223     my $make_frag = '';
224
225     foreach my $macro (qw(MM_Win32_VERSION))
226     {
227         next unless defined $self->{$macro};
228         $make_frag .= "$macro = $self->{$macro}\n";
229     }
230
231     return $make_frag;
232 }
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
284 =item static_lib
285
286 Changes how to run the linker.
287
288 The rest is duplicate code from MM_Unix.  Should move the linker code
289 to its own method.
290
291 =cut
292
293 sub static_lib {
294     my($self) = @_;
295     return '' unless $self->has_link_code;
296
297     my(@m);
298     push(@m, <<'END');
299 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
300         $(RM_RF) $@
301 END
302
303     # If this extension has its own library (eg SDBM_File)
304     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
305     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
306         $(CP) $(MYEXTLIB) $@
307 MAKE_FRAG
308
309     push @m,
310 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
311                           : ($GCC ? '-ru $@ $(OBJECT)'
312                                   : '-out:$@ $(OBJECT)')).q{
313         $(CHMOD) $(PERM_RWX) $@
314         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
315 };
316
317     # Old mechanism - still available:
318     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
319         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
320 MAKE_FRAG
321
322     join('', @m);
323 }
324
325
326 =item dynamic_lib
327
328 Complicated stuff for Win32 that I don't understand. :(
329
330 =cut
331
332 sub dynamic_lib {
333     my($self, %attribs) = @_;
334     return '' unless $self->needs_linking(); #might be because of a subdir
335
336     return '' unless $self->has_link_code;
337
338     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
339     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
340     my($ldfrom) = '$(LDFROM)';
341     my(@m);
342
343     push(@m,'
344 # This section creates the dynamically loadable $(INST_DYNAMIC)
345 # from $(OBJECT) and possibly $(MYEXTLIB).
346 OTHERLDFLAGS = '.$otherldflags.'
347 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
348
349 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
350 ');
351     if ($GCC) {
352       push(@m,
353        q{       }.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp
354         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
355         }.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
356         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
357     } elsif ($BORLAND) {
358       push(@m,
359        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
360        .($self->is_make_type('dmake')
361                 ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
362                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
363                 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
364                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
365        .q{,$(RESFILES)});
366     } else {    # VC
367       push(@m,
368        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
369       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
370
371       # Embed the manifest file if it exists
372       push(@m, q{
373         if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
374         if exist $@.manifest del $@.manifest});
375     }
376     push @m, '
377         $(CHMOD) $(PERM_RWX) $@
378 ';
379
380     join('',@m);
381 }
382
383 =item extra_clean_files
384
385 Clean out some extra dll.{base,exp} files which might be generated by
386 gcc.  Otherwise, take out all *.pdb files.
387
388 =cut
389
390 sub extra_clean_files {
391     my $self = shift;
392
393     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
394 }
395
396 =item init_linker
397
398 =cut
399
400 sub init_linker {
401     my $self = shift;
402
403     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
404     $self->{PERL_ARCHIVE_AFTER} = '';
405     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
406 }
407
408
409 =item perl_script
410
411 Checks for the perl program under several common perl extensions.
412
413 =cut
414
415 sub perl_script {
416     my($self,$file) = @_;
417     return $file if -r $file && -f _;
418     return "$file.pl"  if -r "$file.pl" && -f _;
419     return "$file.plx" if -r "$file.plx" && -f _;
420     return "$file.bat" if -r "$file.bat" && -f _;
421     return;
422 }
423
424
425 =item xs_o
426
427 This target is stubbed out.  Not sure why.
428
429 =cut
430
431 sub xs_o {
432     return ''
433 }
434
435
436 =item pasthru
437
438 All we send is -nologo to nmake to prevent it from printing its damned
439 banner.
440
441 =cut
442
443 sub pasthru {
444     my($self) = shift;
445     return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
446 }
447
448
449 =item arch_check (override)
450
451 Normalize all arguments for consistency of comparison.
452
453 =cut
454
455 sub arch_check {
456     my $self = shift;
457
458     # Win32 is an XS module, minperl won't have it.
459     # arch_check() is not critical, so just fake it.
460     return 1 unless $self->can_load_xs;
461     return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
462 }
463
464 sub _normalize_path_name {
465     my $self = shift;
466     my $file = shift;
467
468     require Win32;
469     my $short = Win32::GetShortPathName($file);
470     return defined $short ? lc $short : lc $file;
471 }
472
473
474 =item oneliner
475
476 These are based on what command.com does on Win98.  They may be wrong
477 for other Windows shells, I don't know.
478
479 =cut
480
481 sub oneliner {
482     my($self, $cmd, $switches) = @_;
483     $switches = [] unless defined $switches;
484
485     # Strip leading and trailing newlines
486     $cmd =~ s{^\n+}{};
487     $cmd =~ s{\n+$}{};
488
489     $cmd = $self->quote_literal($cmd);
490     $cmd = $self->escape_newlines($cmd);
491
492     $switches = join ' ', @$switches;
493
494     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
495 }
496
497
498 sub quote_literal {
499     my($self, $text, $opts) = @_;
500     $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
501
502     # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
503
504     # Apply the Microsoft C/C++ parsing rules
505     $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
506     $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
507     $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
508     $text = qq{"$text"} if $text =~ /[ \t]/;
509
510     # Apply the Command Prompt parsing rules (cmd.exe)
511     my @text = split /("[^"]*")/, $text;
512     # We should also escape parentheses, but it breaks one-liners containing
513     # $(MACRO)s in makefiles.
514     s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
515     $text = join('', @text);
516
517     # dmake expands {{ to { and }} to }.
518     if( $self->is_make_type('dmake') ) {
519         $text =~ s/{/{{/g;
520         $text =~ s/}/}}/g;
521     }
522
523     $text = $opts->{allow_variables}
524       ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
525
526     return $text;
527 }
528
529
530 sub escape_newlines {
531     my($self, $text) = @_;
532
533     # Escape newlines
534     $text =~ s{\n}{\\\n}g;
535
536     return $text;
537 }
538
539
540 =item cd
541
542 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
543 wants:
544
545     cd dir1\dir2
546     command
547     another_command
548     cd ..\..
549
550 =cut
551
552 sub cd {
553     my($self, $dir, @cmds) = @_;
554
555     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
556
557     my $cmd = join "\n\t", map "$_", @cmds;
558
559     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
560
561     # No leading tab and no trailing newline makes for easier embedding.
562     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
563 cd %s
564         %s
565         cd %s
566 MAKE_FRAG
567
568     chomp $make_frag;
569
570     return $make_frag;
571 }
572
573
574 =item max_exec_len
575
576 nmake 1.50 limits command length to 2048 characters.
577
578 =cut
579
580 sub max_exec_len {
581     my $self = shift;
582
583     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
584 }
585
586
587 =item os_flavor
588
589 Windows is Win32.
590
591 =cut
592
593 sub os_flavor {
594     return('Win32');
595 }
596
597
598 =item cflags
599
600 Defines the PERLDLL symbol if we are configured for static building since all
601 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
602 defined.
603
604 =cut
605
606 sub cflags {
607     my($self,$libperl)=@_;
608     return $self->{CFLAGS} if $self->{CFLAGS};
609     return '' unless $self->needs_linking();
610
611     my $base = $self->SUPER::cflags($libperl);
612     foreach (split /\n/, $base) {
613         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
614     };
615     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
616
617     return $self->{CFLAGS} = qq{
618 CCFLAGS = $self->{CCFLAGS}
619 OPTIMIZE = $self->{OPTIMIZE}
620 PERLTYPE = $self->{PERLTYPE}
621 };
622
623 }
624
625 sub is_make_type {
626     my($self, $type) = @_;
627     return !! ($self->make =~ /\b$type(?:\.exe)?$/);
628 }
629
630 1;
631 __END__
632
633 =back
634
635 =cut
636
637