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 = '7.10_01';
  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, except for "gmake" where it is /.
 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                           $self->is_make_type('gmake') ? '/'
 142                                                        : '\\';
 143 }
 144
 145 =item init_tools
 146
 147 Override some of the slower, portable commands with Windows specific ones.
 148
 149 =cut
 150
 151 sub init_tools {
 152     my ($self) = @_;
 153
 154     $self->{NOOP}     ||= 'rem';
 155     $self->{DEV_NULL} ||= '> NUL';
 156
 157     $self->{FIXIN}    ||= $self->{PERL_CORE} ?
 158       "\$(PERLRUN) $self->{PERL_SRC}\\win32\\bin\\pl2bat.pl" :
 159       'pl2bat.bat';
 160
 161     $self->SUPER::init_tools;
 162
 163     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
 164     delete $self->{SHELL};
 165
 166     return;
 167 }
 168
 169
 170 =item init_others
 171
 172 Override the default link and compile tools.
 173
 174 LDLOADLIBS's default is changed to $Config{libs}.
 175
 176 Adjustments are made for Borland's quirks needing -L to come first.
 177
 178 =cut
 179
 180 sub init_others {
 181     my $self = shift;
 182
 183     $self->{LD}     ||= 'link';
 184     $self->{AR}     ||= 'lib';
 185
 186     $self->SUPER::init_others;
 187
 188     $self->{LDLOADLIBS} ||= $Config{libs};
 189     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
 190     if ($BORLAND) {
 191         my $libs = $self->{LDLOADLIBS};
 192         my $libpath = '';
 193         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
 194             $libpath .= ' ' if length $libpath;
 195             $libpath .= $1;
 196         }
 197         $self->{LDLOADLIBS} = $libs;
 198         $self->{LDDLFLAGS} ||= $Config{lddlflags};
 199         $self->{LDDLFLAGS} .= " $libpath";
 200     }
 201
 202     return;
 203 }
 204
 205
 206 =item init_platform
 207
 208 Add MM_Win32_VERSION.
 209
 210 =item platform_constants
 211
 212 =cut
 213
 214 sub init_platform {
 215     my($self) = shift;
 216
 217     $self->{MM_Win32_VERSION} = $VERSION;
 218
 219     return;
 220 }
 221
 222 sub platform_constants {
 223     my($self) = shift;
 224     my $make_frag = '';
 225
 226     foreach my $macro (qw(MM_Win32_VERSION))
 227     {
 228         next unless defined $self->{$macro};
 229         $make_frag .= "$macro = $self->{$macro}\n";
 230     }
 231
 232     return $make_frag;
 233 }
 234
 235 =item specify_shell
 236
 237 Set SHELL to $ENV{COMSPEC} only if make is type 'gmake'.
 238
 239 =cut
 240
 241 sub specify_shell {
 242     my $self = shift;
 243     return '' unless $self->is_make_type('gmake');
 244     "\nSHELL = $ENV{COMSPEC}\n";
 245 }
 246
 247 =item constants
 248
 249 Add MAXLINELENGTH for dmake before all the constants are output.
 250
 251 =cut
 252
 253 sub constants {
 254     my $self = shift;
 255
 256     my $make_text = $self->SUPER::constants;
 257     return $make_text unless $self->is_make_type('dmake');
 258
 259     # dmake won't read any single "line" (even those with escaped newlines)
 260     # larger than a certain size which can be as small as 8k.  PM_TO_BLIB
 261     # on large modules like DateTime::TimeZone can create lines over 32k.
 262     # So we'll crank it up to a <ironic>WHOPPING</ironic> 64k.
 263     #
 264     # This has to come here before all the constants and not in
 265     # platform_constants which is after constants.
 266     my $size = $self->{MAXLINELENGTH} || 800000;
 267     my $prefix = qq{
 268 # Get dmake to read long commands like PM_TO_BLIB
 269 MAXLINELENGTH = $size
 270
 271 };
 272
 273     return $prefix . $make_text;
 274 }
 275
 276
 277 =item special_targets
 278
 279 Add .USESHELL target for dmake.
 280
 281 =cut
 282
 283 sub special_targets {
 284     my($self) = @_;
 285
 286     my $make_frag = $self->SUPER::special_targets;
 287
 288     $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
 289 .USESHELL :
 290 MAKE_FRAG
 291
 292     return $make_frag;
 293 }
 294
 295
 296 =item static_lib
 297
 298 Changes how to run the linker.
 299
 300 The rest is duplicate code from MM_Unix.  Should move the linker code
 301 to its own method.
 302
 303 =cut
 304
 305 sub static_lib {
 306     my($self) = @_;
 307     return '' unless $self->has_link_code;
 308
 309     my(@m);
 310     push(@m, <<'END');
 311 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
 312         $(RM_RF) $@
 313 END
 314
 315     # If this extension has its own library (eg SDBM_File)
 316     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
 317     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
 318         $(CP) $(MYEXTLIB) $@
 319 MAKE_FRAG
 320
 321     push @m,
 322 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 323                           : ($GCC ? '-ru $@ $(OBJECT)'
 324                                   : '-out:$@ $(OBJECT)')).q{
 325         $(CHMOD) $(PERM_RWX) $@
 326         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
 327 };
 328
 329     # Old mechanism - still available:
 330     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
 331         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
 332 MAKE_FRAG
 333
 334     join('', @m);
 335 }
 336
 337
 338 =item dynamic_lib
 339
 340 Complicated stuff for Win32 that I don't understand. :(
 341
 342 =cut
 343
 344 sub dynamic_lib {
 345     my($self, %attribs) = @_;
 346     return '' unless $self->needs_linking(); #might be because of a subdir
 347
 348     return '' unless $self->has_link_code;
 349
 350     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
 351     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
 352     my($ldfrom) = '$(LDFROM)';
 353     my(@m);
 354
 355     push(@m,'
 356 # This section creates the dynamically loadable $(INST_DYNAMIC)
 357 # from $(OBJECT) and possibly $(MYEXTLIB).
 358 OTHERLDFLAGS = '.$otherldflags.'
 359 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 360
 361 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)
 362 ');
 363     if ($GCC) {
 364       push(@m,
 365        q{       }.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp
 366         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp
 367         }.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
 368         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp });
 369     } elsif ($BORLAND) {
 370       push(@m,
 371        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
 372        .($self->is_make_type('dmake')
 373                 ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) }
 374                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
 375                 : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) }
 376                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
 377        .q{,$(RESFILES)});
 378     } else {    # VC
 379       push(@m,
 380        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
 381       .q{$(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:$(EXPORT_LIST)});
 382
 383       # Embed the manifest file if it exists
 384       push(@m, q{
 385         if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
 386         if exist $@.manifest del $@.manifest});
 387     }
 388     push @m, '
 389         $(CHMOD) $(PERM_RWX) $@
 390 ';
 391
 392     join('',@m);
 393 }
 394
 395 =item extra_clean_files
 396
 397 Clean out some extra dll.{base,exp} files which might be generated by
 398 gcc.  Otherwise, take out all *.pdb files.
 399
 400 =cut
 401
 402 sub extra_clean_files {
 403     my $self = shift;
 404
 405     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
 406 }
 407
 408 =item init_linker
 409
 410 =cut
 411
 412 sub init_linker {
 413     my $self = shift;
 414
 415     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
 416     $self->{PERL_ARCHIVEDEP}    = "\$(PERL_INCDEP)\\$Config{libperl}";
 417     $self->{PERL_ARCHIVE_AFTER} = '';
 418     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
 419 }
 420
 421
 422 =item perl_script
 423
 424 Checks for the perl program under several common perl extensions.
 425
 426 =cut
 427
 428 sub perl_script {
 429     my($self,$file) = @_;
 430     return $file if -r $file && -f _;
 431     return "$file.pl"  if -r "$file.pl" && -f _;
 432     return "$file.plx" if -r "$file.plx" && -f _;
 433     return "$file.bat" if -r "$file.bat" && -f _;
 434     return;
 435 }
 436
 437 sub can_dep_space {
 438     my $self = shift;
 439     1; # with Win32::GetShortPathName
 440 }
 441
 442 =item quote_dep
 443
 444 =cut
 445
 446 sub quote_dep {
 447     my ($self, $arg) = @_;
 448     if ($arg =~ / / and not $self->is_make_type('gmake')) {
 449         require Win32;
 450         $arg = Win32::GetShortPathName($arg);
 451         die <<EOF if not defined $arg or $arg =~ / /;
 452 Tried to use make dependency with space for non-GNU make:
 453   '$arg'
 454 Fallback to short pathname failed.
 455 EOF
 456         return $arg;
 457     }
 458     return $self->SUPER::quote_dep($arg);
 459 }
 460
 461 =item xs_o
 462
 463 This target is stubbed out.  Not sure why.
 464
 465 =cut
 466
 467 sub xs_o {
 468     return ''
 469 }
 470
 471
 472 =item pasthru
 473
 474 All we send is -nologo to nmake to prevent it from printing its damned
 475 banner.
 476
 477 =cut
 478
 479 sub pasthru {
 480     my($self) = shift;
 481     return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
 482 }
 483
 484
 485 =item arch_check (override)
 486
 487 Normalize all arguments for consistency of comparison.
 488
 489 =cut
 490
 491 sub arch_check {
 492     my $self = shift;
 493
 494     # Win32 is an XS module, minperl won't have it.
 495     # arch_check() is not critical, so just fake it.
 496     return 1 unless $self->can_load_xs;
 497     return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
 498 }
 499
 500 sub _normalize_path_name {
 501     my $self = shift;
 502     my $file = shift;
 503
 504     require Win32;
 505     my $short = Win32::GetShortPathName($file);
 506     return defined $short ? lc $short : lc $file;
 507 }
 508
 509
 510 =item oneliner
 511
 512 These are based on what command.com does on Win98.  They may be wrong
 513 for other Windows shells, I don't know.
 514
 515 =cut
 516
 517 sub oneliner {
 518     my($self, $cmd, $switches) = @_;
 519     $switches = [] unless defined $switches;
 520
 521     # Strip leading and trailing newlines
 522     $cmd =~ s{^\n+}{};
 523     $cmd =~ s{\n+$}{};
 524
 525     $cmd = $self->quote_literal($cmd);
 526     $cmd = $self->escape_newlines($cmd);
 527
 528     $switches = join ' ', @$switches;
 529
 530     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
 531 }
 532
 533
 534 sub quote_literal {
 535     my($self, $text, $opts) = @_;
 536     $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
 537
 538     # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
 539
 540     # Apply the Microsoft C/C++ parsing rules
 541     $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
 542     $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
 543     $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
 544     $text = qq{"$text"} if $text =~ /[ \t]/;
 545
 546     # Apply the Command Prompt parsing rules (cmd.exe)
 547     my @text = split /("[^"]*")/, $text;
 548     # We should also escape parentheses, but it breaks one-liners containing
 549     # $(MACRO)s in makefiles.
 550     s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
 551     $text = join('', @text);
 552
 553     # dmake expands {{ to { and }} to }.
 554     if( $self->is_make_type('dmake') ) {
 555         $text =~ s/{/{{/g;
 556         $text =~ s/}/}}/g;
 557     }
 558
 559     $text = $opts->{allow_variables}
 560       ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
 561
 562     return $text;
 563 }
 564
 565
 566 sub escape_newlines {
 567     my($self, $text) = @_;
 568
 569     # Escape newlines
 570     $text =~ s{\n}{\\\n}g;
 571
 572     return $text;
 573 }
 574
 575
 576 =item cd
 577
 578 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
 579 wants:
 580
 581     cd dir1\dir2
 582     command
 583     another_command
 584     cd ..\..
 585
 586 =cut
 587
 588 sub cd {
 589     my($self, $dir, @cmds) = @_;
 590
 591     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
 592
 593     my $cmd = join "\n\t", map "$_", @cmds;
 594
 595     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
 596
 597     # No leading tab and no trailing newline makes for easier embedding.
 598     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
 599 cd %s
 600         %s
 601         cd %s
 602 MAKE_FRAG
 603
 604     chomp $make_frag;
 605
 606     return $make_frag;
 607 }
 608
 609
 610 =item max_exec_len
 611
 612 nmake 1.50 limits command length to 2048 characters.
 613
 614 =cut
 615
 616 sub max_exec_len {
 617     my $self = shift;
 618
 619     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
 620 }
 621
 622
 623 =item os_flavor
 624
 625 Windows is Win32.
 626
 627 =cut
 628
 629 sub os_flavor {
 630     return('Win32');
 631 }
 632
 633
 634 =item cflags
 635
 636 Defines the PERLDLL symbol if we are configured for static building since all
 637 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
 638 defined.
 639
 640 =cut
 641
 642 sub cflags {
 643     my($self,$libperl)=@_;
 644     return $self->{CFLAGS} if $self->{CFLAGS};
 645     return '' unless $self->needs_linking();
 646
 647     my $base = $self->SUPER::cflags($libperl);
 648     foreach (split /\n/, $base) {
 649         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
 650     };
 651     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
 652
 653     return $self->{CFLAGS} = qq{
 654 CCFLAGS = $self->{CCFLAGS}
 655 OPTIMIZE = $self->{OPTIMIZE}
 656 PERLTYPE = $self->{PERLTYPE}
 657 };
 658
 659 }
 660
 661 1;
 662 __END__
 663
 664 =back