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