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.49_01';
  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     # The ^ makes sure its not interpreted as an escape in nmake
 130     $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' :
 131                           $self->is_make_type('dmake') ? '\\\\'
 132                                                        : '\\';
 133 }
 134
 135 =item B<init_others>
 136
 137 Override some of the Unix specific commands with portable
 138 ExtUtils::Command ones.
 139
 140 Also provide defaults for LD and AR in case the %Config values aren't
 141 set.
 142
 143 LDLOADLIBS's default is changed to $Config{libs}.
 144
 145 Adjustments are made for Borland's quirks needing -L to come first.
 146
 147 =cut
 148
 149 sub init_others {
 150     my ($self) = @_;
 151
 152     # Used in favor of echo because echo won't strip quotes. :(
 153     $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
 154     $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
 155
 156     $self->{TOUCH}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
 157     $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod';
 158     $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
 159     $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
 160     $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
 161     $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
 162     $self->{NOOP}     ||= 'rem';
 163     $self->{TEST_F}   ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f';
 164     $self->{DEV_NULL} ||= '> NUL';
 165
 166     $self->{FIXIN}    ||= $self->{PERL_CORE} ?
 167       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" :
 168       'pl2bat.bat';
 169
 170     $self->{LD}     ||= $Config{ld} || 'link';
 171     $self->{AR}     ||= $Config{ar} || 'lib';
 172
 173     $self->SUPER::init_others;
 174
 175     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
 176     delete $self->{SHELL};
 177
 178     $self->{LDLOADLIBS} ||= $Config{libs};
 179     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
 180     if ($BORLAND) {
 181         my $libs = $self->{LDLOADLIBS};
 182         my $libpath = '';
 183         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
 184             $libpath .= ' ' if length $libpath;
 185             $libpath .= $1;
 186         }
 187         $self->{LDLOADLIBS} = $libs;
 188         $self->{LDDLFLAGS} ||= $Config{lddlflags};
 189         $self->{LDDLFLAGS} .= " $libpath";
 190     }
 191
 192     return 1;
 193 }
 194
 195
 196 =item init_platform
 197
 198 Add MM_Win32_VERSION.
 199
 200 =item platform_constants
 201
 202 =cut
 203
 204 sub init_platform {
 205     my($self) = shift;
 206
 207     $self->{MM_Win32_VERSION} = $VERSION;
 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
 224 =item special_targets
 225
 226 Add .USESHELL target for dmake.
 227
 228 =cut
 229
 230 sub special_targets {
 231     my($self) = @_;
 232
 233     my $make_frag = $self->SUPER::special_targets;
 234
 235     $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
 236 .USESHELL :
 237 MAKE_FRAG
 238
 239     return $make_frag;
 240 }
 241
 242
 243 =item static_lib
 244
 245 Changes how to run the linker.
 246
 247 The rest is duplicate code from MM_Unix.  Should move the linker code
 248 to its own method.
 249
 250 =cut
 251
 252 sub static_lib {
 253     my($self) = @_;
 254     return '' unless $self->has_link_code;
 255
 256     my(@m);
 257     push(@m, <<'END');
 258 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
 259         $(RM_RF) $@
 260 END
 261
 262     # If this extension has its own library (eg SDBM_File)
 263     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
 264     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
 265         $(CP) $(MYEXTLIB) $@
 266 MAKE_FRAG
 267
 268     push @m,
 269 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 270                           : ($GCC ? '-ru $@ $(OBJECT)'
 271                                   : '-out:$@ $(OBJECT)')).q{
 272         $(CHMOD) $(PERM_RWX) $@
 273         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
 274 };
 275
 276     # Old mechanism - still available:
 277     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
 278         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
 279 MAKE_FRAG
 280
 281     join('', @m);
 282 }
 283
 284
 285 =item dynamic_lib
 286
 287 Complicated stuff for Win32 that I don't understand. :(
 288
 289 =cut
 290
 291 sub dynamic_lib {
 292     my($self, %attribs) = @_;
 293     return '' unless $self->needs_linking(); #might be because of a subdir
 294
 295     return '' unless $self->has_link_code;
 296
 297     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
 298     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
 299     my($ldfrom) = '$(LDFROM)';
 300     my(@m);
 301
 302 # one thing for GCC/Mingw32:
 303 # we try to overcome non-relocateable-DLL problems by generating
 304 #    a (hopefully unique) image-base from the dll's name
 305 # -- BKS, 10-19-1999
 306     if ($GCC) {
 307         my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
 308         $dllname =~ /(....)(.{0,4})/;
 309         my $baseaddr = unpack("n", $1 ^ $2);
 310         $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
 311     }
 312
 313     push(@m,'
 314 # This section creates the dynamically loadable $(INST_DYNAMIC)
 315 # from $(OBJECT) and possibly $(MYEXTLIB).
 316 OTHERLDFLAGS = '.$otherldflags.'
 317 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 318
 319 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 320 ');
 321     if ($GCC) {
 322       push(@m,
 323        q{       dlltool --def $(EXPORT_LIST) --output-exp dll.exp
 324         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
 325         dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
 326         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
 327     } elsif ($BORLAND) {
 328       push(@m,
 329        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
 330        .($self->is_make_type('dmake')
 331                 ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
 332                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
 333                 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
 334                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
 335        .q{,$(RESFILES)});
 336     } else {    # VC
 337       push(@m,
 338        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
 339       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
 340
 341       # VS2005 (aka VC 8) or higher, but not for 64-bit compiler from Platform SDK
 342       if ($Config{ivsize} == 4 && $Config{cc} eq 'cl' and $Config{ccversion} =~ /^(\d+)/ and $1 >= 14)
 343     {
 344         push(@m,
 345           q{
 346         mt -nologo -manifest $@.manifest -outputresource:$@;2 && del $@.manifest});
 347       }
 348     }
 349     push @m, '
 350         $(CHMOD) $(PERM_RWX) $@
 351 ';
 352
 353     join('',@m);
 354 }
 355
 356 =item extra_clean_files
 357
 358 Clean out some extra dll.{base,exp} files which might be generated by
 359 gcc.  Otherwise, take out all *.pdb files.
 360
 361 =cut
 362
 363 sub extra_clean_files {
 364     my $self = shift;
 365
 366     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
 367 }
 368
 369 =item init_linker
 370
 371 =cut
 372
 373 sub init_linker {
 374     my $self = shift;
 375
 376     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$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
 398 =item xs_o
 399
 400 This target is stubbed out.  Not sure why.
 401
 402 =cut
 403
 404 sub xs_o {
 405     return ''
 406 }
 407
 408
 409 =item pasthru
 410
 411 All we send is -nologo to nmake to prevent it from printing its damned
 412 banner.
 413
 414 =cut
 415
 416 sub pasthru {
 417     my($self) = shift;
 418     return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
 419 }
 420
 421
 422 =item oneliner
 423
 424 These are based on what command.com does on Win98.  They may be wrong
 425 for other Windows shells, I don't know.
 426
 427 =cut
 428
 429 sub oneliner {
 430     my($self, $cmd, $switches) = @_;
 431     $switches = [] unless defined $switches;
 432
 433     # Strip leading and trailing newlines
 434     $cmd =~ s{^\n+}{};
 435     $cmd =~ s{\n+$}{};
 436
 437     $cmd = $self->quote_literal($cmd);
 438     $cmd = $self->escape_newlines($cmd);
 439
 440     $switches = join ' ', @$switches;
 441
 442     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
 443 }
 444
 445
 446 sub quote_literal {
 447     my($self, $text) = @_;
 448
 449     # I don't know if this is correct, but it seems to work on
 450     # Win98's command.com
 451     $text =~ s{"}{\\"}g;
 452
 453     # dmake eats '{' inside double quotes and leaves alone { outside double
 454     # quotes; however it transforms {{ into { either inside and outside double
 455     # quotes.  It also translates }} into }.  The escaping below is not
 456     # 100% correct.
 457     if( $self->is_make_type('dmake') ) {
 458         $text =~ s/{/{{/g;
 459         $text =~ s/}}/}}}/g;
 460     }
 461
 462     return qq{"$text"};
 463 }
 464
 465
 466 sub escape_newlines {
 467     my($self, $text) = @_;
 468
 469     # Escape newlines
 470     $text =~ s{\n}{\\\n}g;
 471
 472     return $text;
 473 }
 474
 475
 476 =item cd
 477
 478 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
 479 wants:
 480
 481     cd dir
 482     command
 483     another_command
 484     cd ..
 485
 486 NOTE: This only works with simple relative directories.  Throw it an absolute dir or something with .. in it and things will go wrong.
 487
 488 =cut
 489
 490 sub cd {
 491     my($self, $dir, @cmds) = @_;
 492
 493     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
 494
 495     my $cmd = join "\n\t", map "$_", @cmds;
 496
 497     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
 498
 499     # No leading tab and no trailing newline makes for easier embedding.
 500     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
 501 cd %s
 502         %s
 503         cd %s
 504 MAKE_FRAG
 505
 506     chomp $make_frag;
 507
 508     return $make_frag;
 509 }
 510
 511
 512 =item max_exec_len
 513
 514 nmake 1.50 limits command length to 2048 characters.
 515
 516 =cut
 517
 518 sub max_exec_len {
 519     my $self = shift;
 520
 521     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
 522 }
 523
 524
 525 =item os_flavor
 526
 527 Windows is Win32.
 528
 529 =cut
 530
 531 sub os_flavor {
 532     return('Win32');
 533 }
 534
 535
 536 =item cflags
 537
 538 Defines the PERLDLL symbol if we are configured for static building since all
 539 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
 540 defined.
 541
 542 =cut
 543
 544 sub cflags {
 545     my($self,$libperl)=@_;
 546     return $self->{CFLAGS} if $self->{CFLAGS};
 547     return '' unless $self->needs_linking();
 548
 549     my $base = $self->SUPER::cflags($libperl);
 550     foreach (split /\n/, $base) {
 551         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
 552     };
 553     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
 554
 555     return $self->{CFLAGS} = qq{
 556 CCFLAGS = $self->{CCFLAGS}
 557 OPTIMIZE = $self->{OPTIMIZE}
 558 PERLTYPE = $self->{PERLTYPE}
 559 };
 560
 561 }
 562
 563 sub is_make_type {
 564     my($self, $type) = @_;
 565     return !! ($self->make =~ /\b$type(?:\.exe)?$/);
 566 }
 567
 568 1;
 569 __END__
 570
 571 =back
 572
 573 =cut
 574
 575