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