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_02';
  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       # Embed the manifest file if it exists
 342       push(@m, q{
 343         if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
 344         if exist $@.manifest del $@.manifest});
 345     }
 346     push @m, '
 347         $(CHMOD) $(PERM_RWX) $@
 348 ';
 349
 350     join('',@m);
 351 }
 352
 353 =item extra_clean_files
 354
 355 Clean out some extra dll.{base,exp} files which might be generated by
 356 gcc.  Otherwise, take out all *.pdb files.
 357
 358 =cut
 359
 360 sub extra_clean_files {
 361     my $self = shift;
 362
 363     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
 364 }
 365
 366 =item init_linker
 367
 368 =cut
 369
 370 sub init_linker {
 371     my $self = shift;
 372
 373     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
 374     $self->{PERL_ARCHIVE_AFTER} = '';
 375     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
 376 }
 377
 378
 379 =item perl_script
 380
 381 Checks for the perl program under several common perl extensions.
 382
 383 =cut
 384
 385 sub perl_script {
 386     my($self,$file) = @_;
 387     return $file if -r $file && -f _;
 388     return "$file.pl"  if -r "$file.pl" && -f _;
 389     return "$file.plx" if -r "$file.plx" && -f _;
 390     return "$file.bat" if -r "$file.bat" && -f _;
 391     return;
 392 }
 393
 394
 395 =item xs_o
 396
 397 This target is stubbed out.  Not sure why.
 398
 399 =cut
 400
 401 sub xs_o {
 402     return ''
 403 }
 404
 405
 406 =item pasthru
 407
 408 All we send is -nologo to nmake to prevent it from printing its damned
 409 banner.
 410
 411 =cut
 412
 413 sub pasthru {
 414     my($self) = shift;
 415     return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
 416 }
 417
 418
 419 =item oneliner
 420
 421 These are based on what command.com does on Win98.  They may be wrong
 422 for other Windows shells, I don't know.
 423
 424 =cut
 425
 426 sub oneliner {
 427     my($self, $cmd, $switches) = @_;
 428     $switches = [] unless defined $switches;
 429
 430     # Strip leading and trailing newlines
 431     $cmd =~ s{^\n+}{};
 432     $cmd =~ s{\n+$}{};
 433
 434     $cmd = $self->quote_literal($cmd);
 435     $cmd = $self->escape_newlines($cmd);
 436
 437     $switches = join ' ', @$switches;
 438
 439     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
 440 }
 441
 442
 443 sub quote_literal {
 444     my($self, $text) = @_;
 445
 446     # I don't know if this is correct, but it seems to work on
 447     # Win98's command.com
 448     $text =~ s{"}{\\"}g;
 449
 450     # dmake eats '{' inside double quotes and leaves alone { outside double
 451     # quotes; however it transforms {{ into { either inside and outside double
 452     # quotes.  It also translates }} into }.  The escaping below is not
 453     # 100% correct.
 454     if( $self->is_make_type('dmake') ) {
 455         $text =~ s/{/{{/g;
 456         $text =~ s/}}/}}}/g;
 457     }
 458
 459     return qq{"$text"};
 460 }
 461
 462
 463 sub escape_newlines {
 464     my($self, $text) = @_;
 465
 466     # Escape newlines
 467     $text =~ s{\n}{\\\n}g;
 468
 469     return $text;
 470 }
 471
 472
 473 =item cd
 474
 475 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
 476 wants:
 477
 478     cd dir
 479     command
 480     another_command
 481     cd ..
 482
 483 NOTE: This only works with simple relative directories.  Throw it an absolute dir or something with .. in it and things will go wrong.
 484
 485 =cut
 486
 487 sub cd {
 488     my($self, $dir, @cmds) = @_;
 489
 490     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
 491
 492     my $cmd = join "\n\t", map "$_", @cmds;
 493
 494     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
 495
 496     # No leading tab and no trailing newline makes for easier embedding.
 497     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
 498 cd %s
 499         %s
 500         cd %s
 501 MAKE_FRAG
 502
 503     chomp $make_frag;
 504
 505     return $make_frag;
 506 }
 507
 508
 509 =item max_exec_len
 510
 511 nmake 1.50 limits command length to 2048 characters.
 512
 513 =cut
 514
 515 sub max_exec_len {
 516     my $self = shift;
 517
 518     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
 519 }
 520
 521
 522 =item os_flavor
 523
 524 Windows is Win32.
 525
 526 =cut
 527
 528 sub os_flavor {
 529     return('Win32');
 530 }
 531
 532
 533 =item cflags
 534
 535 Defines the PERLDLL symbol if we are configured for static building since all
 536 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
 537 defined.
 538
 539 =cut
 540
 541 sub cflags {
 542     my($self,$libperl)=@_;
 543     return $self->{CFLAGS} if $self->{CFLAGS};
 544     return '' unless $self->needs_linking();
 545
 546     my $base = $self->SUPER::cflags($libperl);
 547     foreach (split /\n/, $base) {
 548         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
 549     };
 550     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
 551
 552     return $self->{CFLAGS} = qq{
 553 CCFLAGS = $self->{CCFLAGS}
 554 OPTIMIZE = $self->{OPTIMIZE}
 555 PERLTYPE = $self->{PERLTYPE}
 556 };
 557
 558 }
 559
 560 sub is_make_type {
 561     my($self, $type) = @_;
 562     return !! ($self->make =~ /\b$type(?:\.exe)?$/);
 563 }
 564
 565 1;
 566 __END__
 567
 568 =back
 569
 570 =cut
 571
 572