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.06';
  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     # gotta be careful this isn't interpreted as an escape.
 148     $self->{DIRFILESEP} = '^\\';
 149 }
 150
 151 =item B<init_others>
 152
 153 Override some of the Unix specific commands with portable
 154 ExtUtils::Command ones.
 155
 156 Also provide defaults for LD and AR in case the %Config values aren't
 157 set.
 158
 159 LDLOADLIBS's default is changed to $Config{libs}.
 160
 161 Adjustments are made for Borland's quirks needing -L to come first.
 162
 163 =cut
 164
 165 sub init_others {
 166     my ($self) = @_;
 167
 168     # Used in favor of echo because echo won't strip quotes. :(
 169     $self->{ECHO}     ||= '$(PERLRUN) -le "print qq{@ARGV}"';
 170     $self->{TOUCH}    ||= '$(PERLRUN) -MExtUtils::Command -e touch';
 171     $self->{CHMOD}    ||= '$(PERLRUN) -MExtUtils::Command -e chmod';
 172     $self->{CP}       ||= '$(PERLRUN) -MExtUtils::Command -e cp';
 173     $self->{RM_F}     ||= '$(PERLRUN) -MExtUtils::Command -e rm_f';
 174     $self->{RM_RF}    ||= '$(PERLRUN) -MExtUtils::Command -e rm_rf';
 175     $self->{MV}       ||= '$(PERLRUN) -MExtUtils::Command -e mv';
 176     $self->{NOOP}     ||= 'rem';
 177     $self->{TEST_F}   ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
 178     $self->{DEV_NULL} ||= '> NUL';
 179
 180     # technically speaking, these should be in init_main()
 181     $self->{LD}     ||= $Config{ld} || 'link';
 182     $self->{AR}     ||= $Config{ar} || 'lib';
 183
 184     $self->SUPER::init_others;
 185
 186     $self->{LDLOADLIBS} ||= $Config{libs};
 187     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
 188     if ($BORLAND) {
 189         my $libs = $self->{LDLOADLIBS};
 190         my $libpath = '';
 191         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
 192             $libpath .= ' ' if length $libpath;
 193             $libpath .= $1;
 194         }
 195         $self->{LDLOADLIBS} = $libs;
 196         $self->{LDDLFLAGS} ||= $Config{lddlflags};
 197         $self->{LDDLFLAGS} .= " $libpath";
 198     }
 199
 200     return 1;
 201 }
 202
 203
 204 =item init_platform (o)
 205
 206 Add MM_Win32_VERSION.
 207
 208 =item platform_constants (o)
 209
 210 =cut
 211
 212 sub init_platform {
 213     my($self) = shift;
 214
 215     $self->{MM_Win32_VERSION} = $VERSION;
 216 }
 217
 218 sub platform_constants {
 219     my($self) = shift;
 220     my $make_frag = '';
 221
 222     foreach my $macro (qw(MM_Win32_VERSION))
 223     {
 224         next unless defined $self->{$macro};
 225         $make_frag .= "$macro = $self->{$macro}\n";
 226     }
 227
 228     return $make_frag;
 229 }
 230
 231
 232 =item special_targets (o)
 233
 234 Add .USESHELL target for dmake.
 235
 236 =cut
 237
 238 sub special_targets {
 239     my($self) = @_;
 240
 241     my $make_frag = $self->SUPER::special_targets;
 242
 243     $make_frag .= <<'MAKE_FRAG' if $DMAKE;
 244 .USESHELL :
 245 MAKE_FRAG
 246
 247     return $make_frag;
 248 }
 249
 250
 251 =item static_lib (o)
 252
 253 Changes how to run the linker.
 254
 255 The rest is duplicate code from MM_Unix.  Should move the linker code
 256 to its own method.
 257
 258 =cut
 259
 260 sub static_lib {
 261     my($self) = @_;
 262     return '' unless $self->has_link_code;
 263
 264     my(@m);
 265     push(@m, <<'END');
 266 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
 267         $(RM_RF) $@
 268 END
 269
 270     # If this extension has its own library (eg SDBM_File)
 271     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
 272     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
 273         $(CP) $(MYEXTLIB) $@
 274 MAKE_FRAG
 275
 276     push @m,
 277 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 278                           : ($GCC ? '-ru $@ $(OBJECT)'
 279                                   : '-out:$@ $(OBJECT)')).q{
 280         $(CHMOD) $(PERM_RWX) $@
 281         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
 282 };
 283
 284     # Old mechanism - still available:
 285     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
 286         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
 287 MAKE_FRAG
 288
 289     push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
 290     join('', @m);
 291 }
 292
 293
 294 =item dynamic_lib (o)
 295
 296 Complicated stuff for Win32 that I don't understand. :(
 297
 298 =cut
 299
 300 sub dynamic_lib {
 301     my($self, %attribs) = @_;
 302     return '' unless $self->needs_linking(); #might be because of a subdir
 303
 304     return '' unless $self->has_link_code;
 305
 306     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
 307     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
 308     my($ldfrom) = '$(LDFROM)';
 309     my(@m);
 310
 311 # one thing for GCC/Mingw32:
 312 # we try to overcome non-relocateable-DLL problems by generating
 313 #    a (hopefully unique) image-base from the dll's name
 314 # -- BKS, 10-19-1999
 315     if ($GCC) {
 316         my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
 317         $dllname =~ /(....)(.{0,4})/;
 318         my $baseaddr = unpack("n", $1 ^ $2);
 319         $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
 320     }
 321
 322     push(@m,'
 323 # This section creates the dynamically loadable $(INST_DYNAMIC)
 324 # from $(OBJECT) and possibly $(MYEXTLIB).
 325 OTHERLDFLAGS = '.$otherldflags.'
 326 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 327
 328 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 329 ');
 330     if ($GCC) {
 331       push(@m,
 332        q{       dlltool --def $(EXPORT_LIST) --output-exp dll.exp
 333         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
 334         dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
 335         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
 336     } elsif ($BORLAND) {
 337       push(@m,
 338        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
 339        .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
 340                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
 341                 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
 342                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
 343        .q{,$(RESFILES)});
 344     } else {    # VC
 345       push(@m,
 346        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
 347       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
 348     }
 349     push @m, '
 350         $(CHMOD) $(PERM_RWX) $@
 351 ';
 352
 353     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
 354     join('',@m);
 355 }
 356
 357 =item clean
 358
 359 Clean out some extra dll.{base,exp} files which might be generated by
 360 gcc.  Otherwise, take out all *.pdb files.
 361
 362 =cut
 363
 364 sub clean
 365 {
 366     my ($self) = shift;
 367     my $s = $self->SUPER::clean(@_);
 368     my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
 369     $s .= <<END;
 370 clean ::
 371         -\$(RM_F) $clean
 372
 373 END
 374     return $s;
 375 }
 376
 377 =item init_linker
 378
 379 =cut
 380
 381 sub init_linker {
 382     my $self = shift;
 383
 384     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
 385     $self->{PERL_ARCHIVE_AFTER} = '';
 386     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
 387 }
 388
 389
 390 =item perl_script
 391
 392 Checks for the perl program under several common perl extensions.
 393
 394 =cut
 395
 396 sub perl_script {
 397     my($self,$file) = @_;
 398     return $file if -r $file && -f _;
 399     return "$file.pl"  if -r "$file.pl" && -f _;
 400     return "$file.plx" if -r "$file.plx" && -f _;
 401     return "$file.bat" if -r "$file.bat" && -f _;
 402     return;
 403 }
 404
 405
 406 =item xs_o (o)
 407
 408 This target is stubbed out.  Not sure why.
 409
 410 =cut
 411
 412 sub xs_o {
 413     return ''
 414 }
 415
 416
 417 =item pasthru (o)
 418
 419 All we send is -nologo to nmake to prevent it from printing its damned
 420 banner.
 421
 422 =cut
 423
 424 sub pasthru {
 425     my($self) = shift;
 426     return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
 427 }
 428
 429
 430 =item oneliner (o)
 431
 432 These are based on what command.com does on Win98.  They may be wrong
 433 for other Windows shells, I don't know.
 434
 435 =cut
 436
 437 sub oneliner {
 438     my($self, $cmd, $switches) = @_;
 439     $switches = [] unless defined $switches;
 440
 441     # Strip leading and trailing newlines
 442     $cmd =~ s{^\n+}{};
 443     $cmd =~ s{\n+$}{};
 444
 445     $cmd = $self->quote_literal($cmd);
 446     $cmd = $self->escape_newlines($cmd);
 447
 448     $switches = join ' ', @$switches;
 449
 450     return qq{\$(PERLRUN) $switches -e $cmd};
 451 }
 452
 453
 454 sub quote_literal {
 455     my($self, $text) = @_;
 456
 457     # I don't know if this is correct, but it seems to work on
 458     # Win98's command.com
 459     $text =~ s{"}{\\"}g;
 460
 461     return qq{"$text"};
 462 }
 463
 464
 465 sub escape_newlines {
 466     my($self, $text) = @_;
 467
 468     # Escape newlines
 469     $text =~ s{\n}{\\\n}g;
 470
 471     return $text;
 472 }
 473
 474
 475 =item max_exec_len
 476
 477 Using 31K, a safe number gotten from Windows 2000.
 478
 479 =cut
 480
 481 sub max_exec_len {
 482     my $self = shift;
 483
 484     return $self->{_MAX_EXEC_LEN} ||= 31 * 1024;
 485 }
 486
 487
 488 1;
 489 __END__
 490
 491 =back
 492
 493 =cut
 494
 495