[Summary view] [Print] [Text view]

   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