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 use vars qw(@ISA $VERSION);
  28
  29 require ExtUtils::MM_Any;
  30 require ExtUtils::MM_Unix;
  31 @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  32 $VERSION = '6.42';
  33
  34 $ENV{EMXSHELL} = 'sh'; # to run `commands`
  35
  36 my $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
  37 my $GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
  38
  39
  40 =head2 Overridden methods
  41
  42 =over 4
  43
  44 =item B<dlsyms>
  45
  46 =cut
  47
  48 sub dlsyms {
  49     my($self,%attribs) = @_;
  50
  51     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  52     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
  53     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
  54     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
  55     my(@m);
  56
  57     if (not $self->{SKIPHASH}{'dynamic'}) {
  58         push(@m,"
  59 $self->{BASEEXT}.def: Makefile.PL
  60 ",
  61      q! $(PERLRUN) -MExtUtils::Mksymlists \\
  62      -e "Mksymlists('NAME'=>\"!, $self->{NAME},
  63      q!\", 'DLBASE' => '!,$self->{DLBASE},
  64      # The above two lines quoted differently to work around
  65      # a bug in the 4DOS/4NT command line interpreter.  The visible
  66      # result of the bug was files named q('extension_name',) *with the
  67      # single quotes and the comma* in the extension build directories.
  68      q!', 'DL_FUNCS' => !,neatvalue($funcs),
  69      q!, 'FUNCLIST' => !,neatvalue($funclist),
  70      q!, 'IMPORTS' => !,neatvalue($imports),
  71      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  72 !);
  73     }
  74     join('',@m);
  75 }
  76
  77 =item replace_manpage_separator
  78
  79 Changes the path separator with .
  80
  81 =cut
  82
  83 sub replace_manpage_separator {
  84     my($self,$man) = @_;
  85     $man =~ s,/+,.,g;
  86     $man;
  87 }
  88
  89
  90 =item B<maybe_command>
  91
  92 Since Windows has nothing as simple as an executable bit, we check the
  93 file extension.
  94
  95 The PATHEXT env variable will be used to get a list of extensions that
  96 might indicate a command, otherwise .com, .exe, .bat and .cmd will be
  97 used by default.
  98
  99 =cut
 100
 101 sub maybe_command {
 102     my($self,$file) = @_;
 103     my @e = exists($ENV{'PATHEXT'})
 104           ? split(/;/, $ENV{PATHEXT})
 105           : qw(.com .exe .bat .cmd);
 106     my $e = '';
 107     for (@e) { $e .= "\Q$_\E|" }
 108     chop $e;
 109     # see if file ends in one of the known extensions
 110     if ($file =~ /($e)$/i) {
 111         return $file if -e $file;
 112     }
 113     else {
 114         for (@e) {
 115             return "$file$_" if -e "$file$_";
 116         }
 117     }
 118     return;
 119 }
 120
 121
 122 =item B<init_DIRFILESEP>
 123
 124 Using \ for Windows.
 125
 126 =cut
 127
 128 sub init_DIRFILESEP {
 129     my($self) = shift;
 130
 131     my $make = $self->make;
 132
 133     # The ^ makes sure its not interpreted as an escape in nmake
 134     $self->{DIRFILESEP} = $make eq 'nmake' ? '^\\' :
 135                           $make eq 'dmake' ? '\\\\'
 136                                            : '\\';
 137 }
 138
 139 =item B<init_others>
 140
 141 Override some of the Unix specific commands with portable
 142 ExtUtils::Command ones.
 143
 144 Also provide defaults for LD and AR in case the %Config values aren't
 145 set.
 146
 147 LDLOADLIBS's default is changed to $Config{libs}.
 148
 149 Adjustments are made for Borland's quirks needing -L to come first.
 150
 151 =cut
 152
 153 sub init_others {
 154     my ($self) = @_;
 155
 156     # Used in favor of echo because echo won't strip quotes. :(
 157     $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
 158     $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
 159
 160     $self->{TOUCH}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
 161     $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod';
 162     $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
 163     $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
 164     $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
 165     $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
 166     $self->{NOOP}     ||= 'rem';
 167     $self->{TEST_F}   ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f';
 168     $self->{DEV_NULL} ||= '> NUL';
 169
 170     $self->{FIXIN}    ||= $self->{PERL_CORE} ?
 171       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" :
 172       'pl2bat.bat';
 173
 174     $self->{LD}     ||= $Config{ld} || 'link';
 175     $self->{AR}     ||= $Config{ar} || 'lib';
 176
 177     $self->SUPER::init_others;
 178
 179     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
 180     delete $self->{SHELL};
 181
 182     $self->{LDLOADLIBS} ||= $Config{libs};
 183     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
 184     if ($BORLAND) {
 185         my $libs = $self->{LDLOADLIBS};
 186         my $libpath = '';
 187         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
 188             $libpath .= ' ' if length $libpath;
 189             $libpath .= $1;
 190         }
 191         $self->{LDLOADLIBS} = $libs;
 192         $self->{LDDLFLAGS} ||= $Config{lddlflags};
 193         $self->{LDDLFLAGS} .= " $libpath";
 194     }
 195
 196     return 1;
 197 }
 198
 199
 200 =item init_platform
 201
 202 Add MM_Win32_VERSION.
 203
 204 =item platform_constants
 205
 206 =cut
 207
 208 sub init_platform {
 209     my($self) = shift;
 210
 211     $self->{MM_Win32_VERSION} = $VERSION;
 212 }
 213
 214 sub platform_constants {
 215     my($self) = shift;
 216     my $make_frag = '';
 217
 218     foreach my $macro (qw(MM_Win32_VERSION))
 219     {
 220         next unless defined $self->{$macro};
 221         $make_frag .= "$macro = $self->{$macro}\n";
 222     }
 223
 224     return $make_frag;
 225 }
 226
 227
 228 =item special_targets
 229
 230 Add .USESHELL target for dmake.
 231
 232 =cut
 233
 234 sub special_targets {
 235     my($self) = @_;
 236
 237     my $make_frag = $self->SUPER::special_targets;
 238
 239     $make_frag .= <<'MAKE_FRAG' if $self->make eq 'dmake';
 240 .USESHELL :
 241 MAKE_FRAG
 242
 243     return $make_frag;
 244 }
 245
 246
 247 =item static_lib
 248
 249 Changes how to run the linker.
 250
 251 The rest is duplicate code from MM_Unix.  Should move the linker code
 252 to its own method.
 253
 254 =cut
 255
 256 sub static_lib {
 257     my($self) = @_;
 258     return '' unless $self->has_link_code;
 259
 260     my(@m);
 261     push(@m, <<'END');
 262 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
 263         $(RM_RF) $@
 264 END
 265
 266     # If this extension has its own library (eg SDBM_File)
 267     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
 268     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
 269         $(CP) $(MYEXTLIB) $@
 270 MAKE_FRAG
 271
 272     push @m,
 273 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 274                           : ($GCC ? '-ru $@ $(OBJECT)'
 275                                   : '-out:$@ $(OBJECT)')).q{
 276         $(CHMOD) $(PERM_RWX) $@
 277         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
 278 };
 279
 280     # Old mechanism - still available:
 281     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
 282         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
 283 MAKE_FRAG
 284
 285     join('', @m);
 286 }
 287
 288
 289 =item dynamic_lib
 290
 291 Complicated stuff for Win32 that I don't understand. :(
 292
 293 =cut
 294
 295 sub dynamic_lib {
 296     my($self, %attribs) = @_;
 297     return '' unless $self->needs_linking(); #might be because of a subdir
 298
 299     return '' unless $self->has_link_code;
 300
 301     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
 302     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
 303     my($ldfrom) = '$(LDFROM)';
 304     my(@m);
 305
 306 # one thing for GCC/Mingw32:
 307 # we try to overcome non-relocateable-DLL problems by generating
 308 #    a (hopefully unique) image-base from the dll's name
 309 # -- BKS, 10-19-1999
 310     if ($GCC) {
 311         my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
 312         $dllname =~ /(....)(.{0,4})/;
 313         my $baseaddr = unpack("n", $1 ^ $2);
 314         $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
 315     }
 316
 317     push(@m,'
 318 # This section creates the dynamically loadable $(INST_DYNAMIC)
 319 # from $(OBJECT) and possibly $(MYEXTLIB).
 320 OTHERLDFLAGS = '.$otherldflags.'
 321 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 322
 323 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 324 ');
 325     if ($GCC) {
 326       push(@m,
 327        q{       dlltool --def $(EXPORT_LIST) --output-exp dll.exp
 328         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
 329         dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
 330         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
 331     } elsif ($BORLAND) {
 332       push(@m,
 333        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
 334        .($self->make eq 'dmake'
 335                 ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
 336                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
 337                 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
 338                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
 339        .q{,$(RESFILES)});
 340     } else {    # VC
 341       push(@m,
 342        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
 343       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
 344
 345       # VS2005 (aka VC 8) or higher, but not for 64-bit compiler from Platform SDK
 346       if ($Config{ivsize} == 4 && $Config{cc} eq 'cl' and $Config{ccversion} =~ /^(\d+)/ and $1 >= 14)
 347     {
 348         push(@m,
 349           q{
 350         mt -nologo -manifest $@.manifest -outputresource:$@;2 && del $@.manifest});
 351       }
 352     }
 353     push @m, '
 354         $(CHMOD) $(PERM_RWX) $@
 355 ';
 356
 357     join('',@m);
 358 }
 359
 360 =item extra_clean_files
 361
 362 Clean out some extra dll.{base,exp} files which might be generated by
 363 gcc.  Otherwise, take out all *.pdb files.
 364
 365 =cut
 366
 367 sub extra_clean_files {
 368     my $self = shift;
 369
 370     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
 371 }
 372
 373 =item init_linker
 374
 375 =cut
 376
 377 sub init_linker {
 378     my $self = shift;
 379
 380     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
 381     $self->{PERL_ARCHIVE_AFTER} = '';
 382     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
 383 }
 384
 385
 386 =item perl_script
 387
 388 Checks for the perl program under several common perl extensions.
 389
 390 =cut
 391
 392 sub perl_script {
 393     my($self,$file) = @_;
 394     return $file if -r $file && -f _;
 395     return "$file.pl"  if -r "$file.pl" && -f _;
 396     return "$file.plx" if -r "$file.plx" && -f _;
 397     return "$file.bat" if -r "$file.bat" && -f _;
 398     return;
 399 }
 400
 401
 402 =item xs_o
 403
 404 This target is stubbed out.  Not sure why.
 405
 406 =cut
 407
 408 sub xs_o {
 409     return ''
 410 }
 411
 412
 413 =item pasthru
 414
 415 All we send is -nologo to nmake to prevent it from printing its damned
 416 banner.
 417
 418 =cut
 419
 420 sub pasthru {
 421     my($self) = shift;
 422     return "PASTHRU = " . ($self->make eq 'nmake' ? "-nologo" : "");
 423 }
 424
 425
 426 =item oneliner
 427
 428 These are based on what command.com does on Win98.  They may be wrong
 429 for other Windows shells, I don't know.
 430
 431 =cut
 432
 433 sub oneliner {
 434     my($self, $cmd, $switches) = @_;
 435     $switches = [] unless defined $switches;
 436
 437     # Strip leading and trailing newlines
 438     $cmd =~ s{^\n+}{};
 439     $cmd =~ s{\n+$}{};
 440
 441     $cmd = $self->quote_literal($cmd);
 442     $cmd = $self->escape_newlines($cmd);
 443
 444     $switches = join ' ', @$switches;
 445
 446     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
 447 }
 448
 449
 450 sub quote_literal {
 451     my($self, $text) = @_;
 452
 453     # I don't know if this is correct, but it seems to work on
 454     # Win98's command.com
 455     $text =~ s{"}{\\"}g;
 456
 457     # dmake eats '{' inside double quotes and leaves alone { outside double
 458     # quotes; however it transforms {{ into { either inside and outside double
 459     # quotes.  It also translates }} into }.  The escaping below is not
 460     # 100% correct.
 461     if( $self->make eq 'dmake' ) {
 462         $text =~ s/{/{{/g;
 463         $text =~ s/}}/}}}/g;
 464     }
 465
 466     return qq{"$text"};
 467 }
 468
 469
 470 sub escape_newlines {
 471     my($self, $text) = @_;
 472
 473     # Escape newlines
 474     $text =~ s{\n}{\\\n}g;
 475
 476     return $text;
 477 }
 478
 479
 480 =item cd
 481
 482 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
 483 wants:
 484
 485     cd dir
 486     command
 487     another_command
 488     cd ..
 489
 490 NOTE: This only works with simple relative directories.  Throw it an absolute dir or something with .. in it and things will go wrong.
 491
 492 =cut
 493
 494 sub cd {
 495     my($self, $dir, @cmds) = @_;
 496
 497     return $self->SUPER::cd($dir, @cmds) unless $self->make eq 'nmake';
 498
 499     my $cmd = join "\n\t", map "$_", @cmds;
 500
 501     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
 502
 503     # No leading tab and no trailing newline makes for easier embedding.
 504     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
 505 cd %s
 506         %s
 507         cd %s
 508 MAKE_FRAG
 509
 510     chomp $make_frag;
 511
 512     return $make_frag;
 513 }
 514
 515
 516 =item max_exec_len
 517
 518 nmake 1.50 limits command length to 2048 characters.
 519
 520 =cut
 521
 522 sub max_exec_len {
 523     my $self = shift;
 524
 525     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
 526 }
 527
 528
 529 =item os_flavor
 530
 531 Windows is Win32.
 532
 533 =cut
 534
 535 sub os_flavor {
 536     return('Win32');
 537 }
 538
 539
 540 =item cflags
 541
 542 Defines the PERLDLL symbol if we are configured for static building since all
 543 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
 544 defined.
 545
 546 =cut
 547
 548 sub cflags {
 549     my($self,$libperl)=@_;
 550     return $self->{CFLAGS} if $self->{CFLAGS};
 551     return '' unless $self->needs_linking();
 552
 553     my $base = $self->SUPER::cflags($libperl);
 554     foreach (split /\n/, $base) {
 555         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
 556     };
 557     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
 558
 559     return $self->{CFLAGS} = qq{
 560 CCFLAGS = $self->{CCFLAGS}
 561 OPTIMIZE = $self->{OPTIMIZE}
 562 PERLTYPE = $self->{PERLTYPE}
 563 };
 564
 565 }
 566
 567 1;
 568 __END__
 569
 570 =back
 571
 572 =cut
 573
 574