1package ExtUtils::MM_Win32;
2
3use strict;
4use warnings;
5
6=head1 NAME
7
8ExtUtils::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
16See L<ExtUtils::MM_Unix> for a documentation of the methods provided
17there. This package overrides the implementation of these methods, not
18the semantics.
19
20=cut
21
22use ExtUtils::MakeMaker::Config;
23use File::Basename;
24use File::Spec;
25use ExtUtils::MakeMaker qw(neatvalue _sprintf562);
26
27require ExtUtils::MM_Any;
28require ExtUtils::MM_Unix;
29our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
30our $VERSION = '7.70';
31$VERSION =~ tr/_//d;
32
33$ENV{EMXSHELL} = 'sh'; # to run `commands`
34
35my ( $BORLAND, $GCC, $MSVC ) = _identify_compiler_environment( \%Config );
36
37sub _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
56sub 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
64On Win32, is C<.def>.
65
66=cut
67
68sub xs_dlsyms_ext {
69    '.def';
70}
71
72=item replace_manpage_separator
73
74Changes the path separator with .
75
76=cut
77
78sub replace_manpage_separator {
79    my($self,$man) = @_;
80    $man =~ s,[/\\]+,.,g;
81    $man;
82}
83
84
85=item B<maybe_command>
86
87Since Windows has nothing as simple as an executable bit, we check the
88file extension.
89
90The PATHEXT env variable will be used to get a list of extensions that
91might indicate a command, otherwise .com, .exe, .bat and .cmd will be
92used by default.
93
94=cut
95
96sub 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
119Using \ for Windows, except for "gmake" where it is /.
120
121=cut
122
123sub 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
135Override some of the slower, portable commands with Windows specific ones.
136
137=cut
138
139sub init_tools {
140    my ($self) = @_;
141
142    $self->{NOOP}     ||= 'rem';
143    $self->{DEV_NULL} ||= '> NUL';
144
145    $self->{FIXIN}    ||= $self->{PERL_CORE} ?
146      "\$(PERLRUN) -I$self->{PERL_SRC}\\cpan\\ExtUtils-PL2Bat\\lib $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
160Override the default link and compile tools.
161
162LDLOADLIBS's default is changed to $Config{libs}.
163
164Adjustments are made for Borland's quirks needing -L to come first.
165
166=cut
167
168sub 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
196Add MM_Win32_VERSION.
197
198=item platform_constants
199
200=cut
201
202sub init_platform {
203    my($self) = shift;
204
205    $self->{MM_Win32_VERSION} = $VERSION;
206
207    return;
208}
209
210sub 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
225Set SHELL to $ENV{COMSPEC} only if make is type 'gmake'.
226
227=cut
228
229sub 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
237Add MAXLINELENGTH for dmake before all the constants are output.
238
239=cut
240
241sub 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
257MAXLINELENGTH = $size
258
259};
260
261    return $prefix . $make_text;
262}
263
264
265=item special_targets
266
267Add .USESHELL target for dmake.
268
269=cut
270
271sub 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 :
278MAKE_FRAG
279
280    return $make_frag;
281}
282
283=item static_lib_pure_cmd
284
285Defines how to run the archive utility
286
287=cut
288
289sub 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
299Methods are overridden here: not dynamic_lib itself, but the utility
300ones that do the OS-specific work.
301
302=cut
303
304sub 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
313EOF
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)
329EOF
330    } else {	# VC
331      push @m, sprintf <<'EOF', $ldfrom, $exportlist;
332	$(LD) -out:$@ $(LDDLFLAGS) %s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:%s
333EOF
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
343sub 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).
350OTHERLDFLAGS = %s
351INST_DYNAMIC_DEP = %s
352EOF
353}
354
355=item extra_clean_files
356
357Clean out some extra dll.{base,exp} files which might be generated by
358gcc.  Otherwise, take out all *.pdb files.
359
360=cut
361
362sub 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
372sub 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
384Checks for the perl program under several common perl extensions.
385
386=cut
387
388sub 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
397sub can_dep_space {
398    my ($self) = @_;
399    return 0 unless $self->can_load_xs;
400    require Win32;
401    require File::Spec;
402    my ($vol, $dir) = File::Spec->splitpath($INC{'ExtUtils/MakeMaker.pm'});
403    # can_dep_space via GetShortPathName, if short paths are supported
404    my $canary = Win32::GetShortPathName(File::Spec->catpath($vol, $dir, 'MakeMaker.pm'));
405    (undef, undef, my $file) = File::Spec->splitpath($canary);
406    return (length $file > 11) ? 0 : 1;
407}
408
409=item quote_dep
410
411=cut
412
413sub quote_dep {
414    my ($self, $arg) = @_;
415    if ($arg =~ / / and not $self->is_make_type('gmake')) {
416        require Win32;
417        $arg = Win32::GetShortPathName($arg);
418        die <<EOF if not defined $arg or $arg =~ / /;
419Tried to use make dependency with space for non-GNU make:
420  '$arg'
421Fallback to short pathname failed.
422EOF
423        return $arg;
424    }
425    return $self->SUPER::quote_dep($arg);
426}
427
428
429=item xs_obj_opt
430
431Override to fixup -o flags for MSVC.
432
433=cut
434
435sub xs_obj_opt {
436    my ($self, $output_file) = @_;
437    ($MSVC ? "/Fo" : "-o ") . $output_file;
438}
439
440
441=item pasthru
442
443All we send is -nologo to nmake to prevent it from printing its damned
444banner.
445
446=cut
447
448sub pasthru {
449    my($self) = shift;
450    my $old = $self->SUPER::pasthru;
451    return $old unless $self->is_make_type('nmake');
452    $old =~ s/(PASTHRU\s*=\s*)/$1 -nologo /;
453    $old;
454}
455
456
457=item arch_check (override)
458
459Normalize all arguments for consistency of comparison.
460
461=cut
462
463sub arch_check {
464    my $self = shift;
465
466    # Win32 is an XS module, minperl won't have it.
467    # arch_check() is not critical, so just fake it.
468    return 1 unless $self->can_load_xs;
469    return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
470}
471
472sub _normalize_path_name {
473    my $self = shift;
474    my $file = shift;
475
476    require Win32;
477    my $short = Win32::GetShortPathName($file);
478    return defined $short ? lc $short : lc $file;
479}
480
481
482=item oneliner
483
484These are based on what command.com does on Win98.  They may be wrong
485for other Windows shells, I don't know.
486
487=cut
488
489sub oneliner {
490    my($self, $cmd, $switches) = @_;
491    $switches = [] unless defined $switches;
492
493    # Strip leading and trailing newlines
494    $cmd =~ s{^\n+}{};
495    $cmd =~ s{\n+$}{};
496
497    $cmd = $self->quote_literal($cmd);
498    $cmd = $self->escape_newlines($cmd);
499
500    $switches = join ' ', @$switches;
501
502    return qq{\$(ABSPERLRUN) $switches -e $cmd --};
503}
504
505
506sub quote_literal {
507    my($self, $text, $opts) = @_;
508    $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
509
510    # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
511
512    # Apply the Microsoft C/C++ parsing rules
513    $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
514    $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
515    $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
516    $text = qq{"$text"} if $text =~ /[ \t#]/; # hash because gmake 4.2.1
517
518    # Apply the Command Prompt parsing rules (cmd.exe)
519    my @text = split /("[^"]*")/, $text;
520    # We should also escape parentheses, but it breaks one-liners containing
521    # $(MACRO)s in makefiles.
522    s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
523    $text = join('', @text);
524
525    # dmake expands {{ to { and }} to }.
526    if( $self->is_make_type('dmake') ) {
527        $text =~ s/{/{{/g;
528        $text =~ s/}/}}/g;
529    }
530
531    $text = $opts->{allow_variables}
532      ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
533
534    return $text;
535}
536
537
538sub escape_newlines {
539    my($self, $text) = @_;
540
541    # Escape newlines
542    $text =~ s{\n}{\\\n}g;
543
544    return $text;
545}
546
547
548=item cd
549
550dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
551wants:
552
553    cd dir1\dir2
554    command
555    another_command
556    cd ..\..
557
558=cut
559
560sub cd {
561    my($self, $dir, @cmds) = @_;
562
563    return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
564
565    my $cmd = join "\n\t", map "$_", @cmds;
566
567    my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
568
569    # No leading tab and no trailing newline makes for easier embedding.
570    my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
571cd %s
572	%s
573	cd %s
574MAKE_FRAG
575
576    chomp $make_frag;
577
578    return $make_frag;
579}
580
581
582=item max_exec_len
583
584nmake 1.50 limits command length to 2048 characters.
585
586=cut
587
588sub max_exec_len {
589    my $self = shift;
590
591    return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
592}
593
594
595=item os_flavor
596
597Windows is Win32.
598
599=cut
600
601sub os_flavor {
602    return('Win32');
603}
604
605=item dbgoutflag
606
607Returns a CC flag that tells the CC to emit a separate debugging symbol file
608when compiling an object file.
609
610=cut
611
612sub dbgoutflag {
613    $MSVC ? '-Fd$(*).pdb' : '';
614}
615
616=item cflags
617
618Defines the PERLDLL symbol if we are configured for static building since all
619code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
620defined.
621
622=cut
623
624sub cflags {
625    my($self,$libperl)=@_;
626    return $self->{CFLAGS} if $self->{CFLAGS};
627    return '' unless $self->needs_linking();
628
629    my $base = $self->SUPER::cflags($libperl);
630    foreach (split /\n/, $base) {
631        /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
632    };
633    $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
634
635    return $self->{CFLAGS} = qq{
636CCFLAGS = $self->{CCFLAGS}
637OPTIMIZE = $self->{OPTIMIZE}
638PERLTYPE = $self->{PERLTYPE}
639};
640
641}
642
643=item make_type
644
645Returns a suitable string describing the type of makefile being written.
646
647=cut
648
649sub make_type {
650    my ($self) = @_;
651    my $make = $self->make;
652    $make = +( File::Spec->splitpath( $make ) )[-1];
653    $make =~ s!\.exe$!!i;
654    if ( $make =~ m![^A-Z0-9]!i ) {
655      ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make;
656    }
657    return "$make-style";
658}
659
6601;
661__END__
662
663=back
664