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