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