1package ExtUtils::MM_Win32;
2
3use strict;
4
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 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.34';
31$VERSION = eval $VERSION;
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) $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 = shift;
399    1; # with Win32::GetShortPathName
400}
401
402=item quote_dep
403
404=cut
405
406sub 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 =~ / /;
412Tried to use make dependency with space for non-GNU make:
413  '$arg'
414Fallback to short pathname failed.
415EOF
416        return $arg;
417    }
418    return $self->SUPER::quote_dep($arg);
419}
420
421
422=item xs_obj_opt
423
424Override to fixup -o flags for MSVC.
425
426=cut
427
428sub xs_obj_opt {
429    my ($self, $output_file) = @_;
430    ($MSVC ? "/Fo" : "-o ") . $output_file;
431}
432
433
434=item pasthru
435
436All we send is -nologo to nmake to prevent it from printing its damned
437banner.
438
439=cut
440
441sub 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
452Normalize all arguments for consistency of comparison.
453
454=cut
455
456sub 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
465sub _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
477These are based on what command.com does on Win98.  They may be wrong
478for other Windows shells, I don't know.
479
480=cut
481
482sub 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
499sub 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
531sub 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
543dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
544wants:
545
546    cd dir1\dir2
547    command
548    another_command
549    cd ..\..
550
551=cut
552
553sub 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;
564cd %s
565	%s
566	cd %s
567MAKE_FRAG
568
569    chomp $make_frag;
570
571    return $make_frag;
572}
573
574
575=item max_exec_len
576
577nmake 1.50 limits command length to 2048 characters.
578
579=cut
580
581sub max_exec_len {
582    my $self = shift;
583
584    return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
585}
586
587
588=item os_flavor
589
590Windows is Win32.
591
592=cut
593
594sub os_flavor {
595    return('Win32');
596}
597
598
599=item cflags
600
601Defines the PERLDLL symbol if we are configured for static building since all
602code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
603defined.
604
605=cut
606
607sub 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{
619CCFLAGS = $self->{CCFLAGS}
620OPTIMIZE = $self->{OPTIMIZE}
621PERLTYPE = $self->{PERLTYPE}
622};
623
624}
625
626=item make_type
627
628Returns a suitable string describing the type of makefile being written.
629
630=cut
631
632sub 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
6431;
644__END__
645
646=back
647