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 L<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.42';
  31 $VERSION =~ tr/_//d;
  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) -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
 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#]/; # hash because gmake 4.2.1
 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 =item dbgoutflag
 599
 600 Returns a CC flag that tells the CC to emit a separate debugging symbol file
 601 when compiling an object file.
 602
 603 =cut
 604
 605 sub dbgoutflag {
 606     $MSVC ? '-Fd$(*).pdb' : '';
 607 }
 608
 609 =item cflags
 610
 611 Defines the PERLDLL symbol if we are configured for static building since all
 612 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
 613 defined.
 614
 615 =cut
 616
 617 sub cflags {
 618     my($self,$libperl)=@_;
 619     return $self->{CFLAGS} if $self->{CFLAGS};
 620     return '' unless $self->needs_linking();
 621
 622     my $base = $self->SUPER::cflags($libperl);
 623     foreach (split /\n/, $base) {
 624         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
 625     };
 626     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
 627
 628     return $self->{CFLAGS} = qq{
 629 CCFLAGS = $self->{CCFLAGS}
 630 OPTIMIZE = $self->{OPTIMIZE}
 631 PERLTYPE = $self->{PERLTYPE}
 632 };
 633
 634 }
 635
 636 =item make_type
 637
 638 Returns a suitable string describing the type of makefile being written.
 639
 640 =cut
 641
 642 sub make_type {
 643     my ($self) = @_;
 644     my $make = $self->make;
 645     $make = +( File::Spec->splitpath( $make ) )[-1];
 646     $make =~ s!\.exe$!!i;
 647     if ( $make =~ m![^A-Z0-9]!i ) {
 648       ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make;
 649     }
 650     return "$make-style";
 651 }
 652
 653 1;
 654 __END__
 655
 656 =back