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 Config; 23use File::Basename; 24use File::Spec; 25use ExtUtils::MakeMaker qw( neatvalue ); 26 27use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE); 28 29require ExtUtils::MM_Any; 30require 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 50sub 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 81Changes the path separator with . 82 83=cut 84 85sub replace_manpage_separator { 86 my($self,$man) = @_; 87 $man =~ s,/+,.,g; 88 $man; 89} 90 91 92=item B<maybe_command> 93 94Since Windows has nothing as simple as an executable bit, we check the 95file extension. 96 97The PATHEXT env variable will be used to get a list of extensions that 98might indicate a command, otherwise .com, .exe, .bat and .cmd will be 99used by default. 100 101=cut 102 103sub 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 126The Win9x shell does not expand globs and I'll play it safe and assume 127other Windows variants don't either. 128 129So we do it for them. 130 131=cut 132 133sub find_tests { 134 return join(' ', <t\\*.t>); 135} 136 137 138=item B<init_DIRFILESEP> 139 140Using \ for Windows. 141 142=cut 143 144sub 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 155Override some of the Unix specific commands with portable 156ExtUtils::Command ones. 157 158Also provide defaults for LD and AR in case the %Config values aren't 159set. 160 161LDLOADLIBS's default is changed to $Config{libs}. 162 163Adjustments are made for Borland's quirks needing -L to come first. 164 165=cut 166 167sub 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 $self->{LD} ||= $Config{ld} || 'link'; 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 212Add MM_Win32_VERSION. 213 214=item platform_constants (o) 215 216=cut 217 218sub init_platform { 219 my($self) = shift; 220 221 $self->{MM_Win32_VERSION} = $VERSION; 222} 223 224sub 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 240Add .USESHELL target for dmake. 241 242=cut 243 244sub special_targets { 245 my($self) = @_; 246 247 my $make_frag = $self->SUPER::special_targets; 248 249 $make_frag .= <<'MAKE_FRAG' if $DMAKE; 250.USESHELL : 251MAKE_FRAG 252 253 return $make_frag; 254} 255 256 257=item static_lib (o) 258 259Changes how to run the linker. 260 261The rest is duplicate code from MM_Unix. Should move the linker code 262to its own method. 263 264=cut 265 266sub 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) $@ 274END 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) $@ 280MAKE_FRAG 281 282 push @m, 283q{ $(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 293MAKE_FRAG 294 295 push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)'); 296 join('', @m); 297} 298 299 300=item dynamic_lib (o) 301 302Complicated stuff for Win32 that I don't understand. :( 303 304=cut 305 306sub 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). 331OTHERLDFLAGS = '.$otherldflags.' 332INST_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 365Clean out some extra dll.{base,exp} files which might be generated by 366gcc. Otherwise, take out all *.pdb files. 367 368=cut 369 370sub clean 371{ 372 my ($self) = shift; 373 my $s = $self->SUPER::clean(@_); 374 my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb'; 375 $s .= <<END; 376clean :: 377 -\$(RM_F) $clean 378 379END 380 return $s; 381} 382 383=item init_linker 384 385=cut 386 387sub init_linker { 388 my $self = shift; 389 390 $self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}"; 391 $self->{PERL_ARCHIVE_AFTER} = ''; 392 $self->{EXPORT_LIST} = '$(BASEEXT).def'; 393} 394 395 396=item perl_script 397 398Checks for the perl program under several common perl extensions. 399 400=cut 401 402sub perl_script { 403 my($self,$file) = @_; 404 return $file if -r $file && -f _; 405 return "$file.pl" if -r "$file.pl" && -f _; 406 return "$file.plx" if -r "$file.plx" && -f _; 407 return "$file.bat" if -r "$file.bat" && -f _; 408 return; 409} 410 411 412=item xs_o (o) 413 414This target is stubbed out. Not sure why. 415 416=cut 417 418sub xs_o { 419 return '' 420} 421 422 423=item pasthru (o) 424 425All we send is -nologo to nmake to prevent it from printing its damned 426banner. 427 428=cut 429 430sub pasthru { 431 my($self) = shift; 432 return "PASTHRU = " . ($NMAKE ? "-nologo" : ""); 433} 434 435 436=item oneliner (o) 437 438These are based on what command.com does on Win98. They may be wrong 439for other Windows shells, I don't know. 440 441=cut 442 443sub oneliner { 444 my($self, $cmd, $switches) = @_; 445 $switches = [] unless defined $switches; 446 447 # Strip leading and trailing newlines 448 $cmd =~ s{^\n+}{}; 449 $cmd =~ s{\n+$}{}; 450 451 $cmd = $self->quote_literal($cmd); 452 $cmd = $self->escape_newlines($cmd); 453 454 $switches = join ' ', @$switches; 455 456 return qq{\$(PERLRUN) $switches -e $cmd}; 457} 458 459 460sub quote_literal { 461 my($self, $text) = @_; 462 463 # I don't know if this is correct, but it seems to work on 464 # Win98's command.com 465 $text =~ s{"}{\\"}g; 466 467 # dmake eats '{' inside double quotes and leaves alone { outside double 468 # quotes; however it transforms {{ into { either inside and outside double 469 # quotes. It also translates }} into }. The escaping below is not 470 # 100% correct. 471 if( $DMAKE ) { 472 $text =~ s/{/{{/g; 473 $text =~ s/}}/}}}/g; 474 } 475 476 return qq{"$text"}; 477} 478 479 480sub escape_newlines { 481 my($self, $text) = @_; 482 483 # Escape newlines 484 $text =~ s{\n}{\\\n}g; 485 486 return $text; 487} 488 489 490=item max_exec_len 491 492nmake 1.50 limits command length to 2048 characters. 493 494=cut 495 496sub max_exec_len { 497 my $self = shift; 498 499 return $self->{_MAX_EXEC_LEN} ||= 2 * 1024; 500} 501 502 503=item os_flavor 504 505Windows is Win32. 506 507=cut 508 509sub os_flavor { 510 return('Win32'); 511} 512 513 5141; 515__END__ 516 517=back 518 519=cut 520 521 522