lib/ExtUtils/CBuilder/Platform/Windows.pm

   1 package ExtUtils::CBuilder::Platform::Windows;
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Basename;
   7 use File::Spec;
   8
   9 use ExtUtils::CBuilder::Base;
  10
  11 use vars qw($VERSION @ISA);
  12 $VERSION = '0.21';
  13 @ISA = qw(ExtUtils::CBuilder::Base);
  14
  15 sub new {
  16   my $class = shift;
  17   my $self = $class->SUPER::new(@_);
  18   my $cf = $self->{config};
  19
  20   # Inherit from an appropriate compiler driver class
  21   unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
  22
  23   return $self;
  24 }
  25
  26 sub _compiler_type {
  27   my $self = shift;
  28   my $cc = $self->{config}{cc};
  29
  30   return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
  31           : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
  32           : 'GCC');
  33 }
  34
  35 sub split_like_shell {
  36   # As it turns out, Windows command-parsing is very different from
  37   # Unix command-parsing.  Double-quotes mean different things,
  38   # backslashes don't necessarily mean escapes, and so on.  So we
  39   # can't use Text::ParseWords::shellwords() to break a command string
  40   # into words.  The algorithm below was bashed out by Randy and Ken
  41   # (mostly Randy), and there are a lot of regression tests, so we
  42   # should feel free to adjust if desired.
  43
  44   (my $self, local $_) = @_;
  45
  46   return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
  47
  48   my @argv;
  49   return @argv unless defined() && length();
  50
  51   my $arg = '';
  52   my( $i, $quote_mode ) = ( 0, 0 );
  53
  54   while ( $i < length() ) {
  55
  56     my $ch      = substr( $_, $i  , 1 );
  57     my $next_ch = substr( $_, $i+1, 1 );
  58
  59     if ( $ch eq '\\' && $next_ch eq '"' ) {
  60       $arg .= '"';
  61       $i++;
  62     } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
  63       $arg .= '\\';
  64       $i++;
  65     } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
  66       $quote_mode = !$quote_mode;
  67       $arg .= '"';
  68       $i++;
  69     } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
  70               ( $i + 2 == length()  ||
  71                 substr( $_, $i + 2, 1 ) eq ' ' )
  72             ) { # for cases like: a"" => [ 'a' ]
  73       push( @argv, $arg );
  74       $arg = '';
  75       $i += 2;
  76     } elsif ( $ch eq '"' ) {
  77       $quote_mode = !$quote_mode;
  78     } elsif ( $ch eq ' ' && !$quote_mode ) {
  79       push( @argv, $arg ) if $arg;
  80       $arg = '';
  81       ++$i while substr( $_, $i + 1, 1 ) eq ' ';
  82     } else {
  83       $arg .= $ch;
  84     }
  85
  86     $i++;
  87   }
  88
  89   push( @argv, $arg ) if defined( $arg ) && length( $arg );
  90   return @argv;
  91 }
  92
  93 sub arg_defines {
  94   my ($self, %args) = @_;
  95   s/"/\\"/g foreach values %args;
  96   return map qq{"-D$_=$args{$_}"}, keys %args;
  97 }
  98
  99 sub compile {
 100   my ($self, %args) = @_;
 101   my $cf = $self->{config};
 102
 103   die "Missing 'source' argument to compile()" unless defined $args{source};
 104
 105   my ($basename, $srcdir) =
 106     ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
 107
 108   $srcdir ||= File::Spec->curdir();
 109
 110   my @defines = $self->arg_defines( %{ $args{defines} || {} } );
 111
 112   my %spec = (
 113     srcdir      => $srcdir,
 114     builddir    => $srcdir,
 115     basename    => $basename,
 116     source      => $args{source},
 117     output      => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
 118     cc          => $cf->{cc},
 119     cflags      => [
 120                      $self->split_like_shell($cf->{ccflags}),
 121                      $self->split_like_shell($cf->{cccdlflags}),
 122                      $self->split_like_shell($cf->{extra_compiler_flags}),
 123                    ],
 124     optimize    => [ $self->split_like_shell($cf->{optimize})    ],
 125     defines     => \@defines,
 126     includes    => [ @{$args{include_dirs} || []} ],
 127     perlinc     => [
 128                      $self->perl_inc(),
 129                      $self->split_like_shell($cf->{incpath}),
 130                    ],
 131     use_scripts => 1, # XXX provide user option to change this???
 132   );
 133
 134   $self->normalize_filespecs(
 135     \$spec{source},
 136     \$spec{output},
 137      $spec{includes},
 138      $spec{perlinc},
 139   );
 140
 141   my @cmds = $self->format_compiler_cmd(%spec);
 142   while ( my $cmd = shift @cmds ) {
 143     $self->do_system( @$cmd )
 144       or die "error building $cf->{dlext} file from '$args{source}'";
 145   }
 146
 147   (my $out = $spec{output}) =~ tr/'"//d;
 148   return $out;
 149 }
 150
 151 sub need_prelink { 1 }
 152
 153 sub link {
 154   my ($self, %args) = @_;
 155   my $cf = $self->{config};
 156
 157   my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
 158   my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
 159   $to ||= File::Spec->curdir();
 160
 161   (my $file_base = $args{module_name}) =~ s/.*:://;
 162   my $output = $args{lib_file} ||
 163     File::Spec->catfile($to, "$file_base.$cf->{dlext}");
 164
 165   # if running in perl source tree, look for libs there, not installed
 166   my $lddlflags = $cf->{lddlflags};
 167   my $perl_src = $self->perl_src();
 168   $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
 169
 170   my %spec = (
 171     srcdir        => $to,
 172     builddir      => $to,
 173     startup       => [ ],
 174     objects       => \@objects,
 175     libs          => [ ],
 176     output        => $output,
 177     ld            => $cf->{ld},
 178     libperl       => $cf->{libperl},
 179     perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
 180     libpath       => [ $self->split_like_shell($cf->{libpth})    ],
 181     lddlflags     => [ $self->split_like_shell($lddlflags) ],
 182     other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
 183     use_scripts   => 1, # XXX provide user option to change this???
 184   );
 185
 186   unless ( $spec{basename} ) {
 187     ($spec{basename} = $args{module_name}) =~ s/.*:://;
 188   }
 189
 190   $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
 191   $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
 192
 193   $spec{output}    ||= File::Spec->catfile( $spec{builddir},
 194                                             $spec{basename}  . '.'.$cf->{dlext}   );
 195   $spec{manifest}  ||= File::Spec->catfile( $spec{builddir},
 196                                             $spec{basename}  . '.'.$cf->{dlext}.'.manifest');
 197   $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
 198                                             $spec{basename}  . $cf->{lib_ext} );
 199   $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
 200                                             $spec{basename}  . '.exp'  );
 201   if ($cf->{cc} eq 'cl') {
 202     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
 203                                             $spec{basename}  . '.pdb'  );
 204   }
 205   elsif ($cf->{cc} eq 'bcc32') {
 206     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
 207                                             $spec{basename}  . '.tds'  );
 208   }
 209   $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
 210                                             $spec{basename}  . '.def'  );
 211   $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
 212                                             $spec{basename}  . '.base' );
 213
 214   $self->add_to_cleanup(
 215     grep defined,
 216     @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
 217   );
 218
 219   foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
 220     $self->normalize_filespecs( \$spec{$opt} );
 221   }
 222
 223   foreach my $opt ( qw(libpath startup objects) ) {
 224     $self->normalize_filespecs( $spec{$opt} );
 225   }
 226
 227   (my $def_base = $spec{def_file}) =~ tr/'"//d;
 228   $def_base =~ s/\.def$//;
 229   $self->prelink( dl_name => $args{module_name},
 230                   dl_file => $def_base,
 231                   dl_base => $spec{basename} );
 232
 233   my @cmds = $self->format_linker_cmd(%spec);
 234   while ( my $cmd = shift @cmds ) {
 235     $self->do_system( @$cmd );
 236   }
 237
 238   $spec{output} =~ tr/'"//d;
 239   return wantarray
 240     ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
 241     : $spec{output};
 242 }
 243
 244 # canonize & quote paths
 245 sub normalize_filespecs {
 246   my ($self, @specs) = @_;
 247   foreach my $spec ( grep defined, @specs ) {
 248     if ( ref $spec eq 'ARRAY') {
 249       $self->normalize_filespecs( map {\$_} grep defined, @$spec )
 250     } elsif ( ref $spec eq 'SCALAR' ) {
 251       $$spec =~ tr/"//d if $$spec;
 252       next unless $$spec;
 253       $$spec = '"' . File::Spec->canonpath($$spec) . '"';
 254     } elsif ( ref $spec eq '' ) {
 255       $spec = '"' . File::Spec->canonpath($spec) . '"';
 256     } else {
 257       die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
 258     }
 259   }
 260 }
 261
 262 # directory of perl's include files
 263 sub perl_inc {
 264   my $self = shift;
 265
 266   my $perl_src = $self->perl_src();
 267
 268   if ($perl_src) {
 269     File::Spec->catdir($perl_src, "lib", "CORE");
 270   } else {
 271     File::Spec->catdir($self->{config}{archlibexp},"CORE");
 272   }
 273 }
 274
 275 1;
 276
 277 ########################################################################
 278
 279 =begin comment
 280
 281 The packages below implement functions for generating properly
 282 formatted commandlines for the compiler being used. Each package
 283 defines two primary functions 'format_linker_cmd()' &
 284 'format_compiler_cmd()' that accepts a list of named arguments (a
 285 hash) and returns a list of formatted options suitable for invoking the
 286 compiler. By default, if the compiler supports scripting of its
 287 operation then a script file is built containing the options while
 288 those options are removed from the commandline, and a reference to the
 289 script is pushed onto the commandline in their place. Scripting the
 290 compiler in this way helps to avoid the problems associated with long
 291 commandlines under some shells.
 292
 293 =end comment
 294
 295 =cut
 296
 297 ########################################################################
 298 package ExtUtils::CBuilder::Platform::Windows::MSVC;
 299
 300 sub format_compiler_cmd {
 301   my ($self, %spec) = @_;
 302
 303   foreach my $path ( @{ $spec{includes} || [] },
 304                      @{ $spec{perlinc}  || [] } ) {
 305     $path = '-I' . $path;
 306   }
 307
 308   %spec = $self->write_compiler_script(%spec)
 309     if $spec{use_scripts};
 310
 311   return [ grep {defined && length} (
 312     $spec{cc},'-nologo','-c',
 313     @{$spec{includes}}      ,
 314     @{$spec{cflags}}        ,
 315     @{$spec{optimize}}      ,
 316     @{$spec{defines}}       ,
 317     @{$spec{perlinc}}       ,
 318     "-Fo$spec{output}"      ,
 319     $spec{source}           ,
 320   ) ];
 321 }
 322
 323 sub write_compiler_script {
 324   my ($self, %spec) = @_;
 325
 326   my $script = File::Spec->catfile( $spec{srcdir},
 327                                     $spec{basename} . '.ccs' );
 328
 329   $self->add_to_cleanup($script);
 330   print "Generating script '$script'\n" if !$self->{quiet};
 331
 332   open( SCRIPT, ">$script" )
 333     or die( "Could not create script '$script': $!" );
 334
 335   print SCRIPT join( "\n",
 336     map { ref $_ ? @{$_} : $_ }
 337     grep defined,
 338     delete(
 339       @spec{ qw(includes cflags optimize defines perlinc) } )
 340   );
 341
 342   close SCRIPT;
 343
 344   push @{$spec{includes}}, '@"' . $script . '"';
 345
 346   return %spec;
 347 }
 348
 349 sub format_linker_cmd {
 350   my ($self, %spec) = @_;
 351   my $cf = $self->{config};
 352
 353   foreach my $path ( @{$spec{libpath}} ) {
 354     $path = "-libpath:$path";
 355   }
 356
 357   my $output = $spec{output};
 358
 359   $spec{def_file}  &&= '-def:'      . $spec{def_file};
 360   $spec{output}    &&= '-out:'      . $spec{output};
 361   $spec{manifest}  &&= '-manifest ' . $spec{manifest};
 362   $spec{implib}    &&= '-implib:'   . $spec{implib};
 363   $spec{map_file}  &&= '-map:'      . $spec{map_file};
 364
 365   %spec = $self->write_linker_script(%spec)
 366     if $spec{use_scripts};
 367
 368   my @cmds; # Stores the series of commands needed to build the module.
 369
 370   push @cmds, [ grep {defined && length} (
 371     $spec{ld}               ,
 372     @{$spec{lddlflags}}     ,
 373     @{$spec{libpath}}       ,
 374     @{$spec{other_ldflags}} ,
 375     @{$spec{startup}}       ,
 376     @{$spec{objects}}       ,
 377     $spec{map_file}         ,
 378     $spec{libperl}          ,
 379     @{$spec{perllibs}}      ,
 380     $spec{def_file}         ,
 381     $spec{implib}           ,
 382     $spec{output}           ,
 383   ) ];
 384
 385   # Embed the manifest file for VC 2005 (aka VC 8) or higher, but not for the 64-bit Platform SDK compiler
 386   if ($cf->{ivsize} == 4 && $cf->{cc} eq 'cl' and $cf->{ccversion} =~ /^(\d+)/ and $1 >= 14) {
 387     push @cmds, [
 388       'mt', '-nologo', $spec{manifest}, '-outputresource:' . "$output;2"
 389     ];
 390   }
 391
 392   return @cmds;
 393 }
 394
 395 sub write_linker_script {
 396   my ($self, %spec) = @_;
 397
 398   my $script = File::Spec->catfile( $spec{srcdir},
 399                                     $spec{basename} . '.lds' );
 400
 401   $self->add_to_cleanup($script);
 402
 403   print "Generating script '$script'\n" if !$self->{quiet};
 404
 405   open( SCRIPT, ">$script" )
 406     or die( "Could not create script '$script': $!" );
 407
 408   print SCRIPT join( "\n",
 409     map { ref $_ ? @{$_} : $_ }
 410     grep defined,
 411     delete(
 412       @spec{ qw(lddlflags libpath other_ldflags
 413                 startup objects libperl perllibs
 414                 def_file implib map_file)            } )
 415   );
 416
 417   close SCRIPT;
 418
 419   push @{$spec{lddlflags}}, '@"' . $script . '"';
 420
 421   return %spec;
 422 }
 423
 424 1;
 425
 426 ########################################################################
 427 package ExtUtils::CBuilder::Platform::Windows::BCC;
 428
 429 sub format_compiler_cmd {
 430   my ($self, %spec) = @_;
 431
 432   foreach my $path ( @{ $spec{includes} || [] },
 433                      @{ $spec{perlinc}  || [] } ) {
 434     $path = '-I' . $path;
 435   }
 436
 437   %spec = $self->write_compiler_script(%spec)
 438     if $spec{use_scripts};
 439
 440   return [ grep {defined && length} (
 441     $spec{cc}, '-c'         ,
 442     @{$spec{includes}}      ,
 443     @{$spec{cflags}}        ,
 444     @{$spec{optimize}}      ,
 445     @{$spec{defines}}       ,
 446     @{$spec{perlinc}}       ,
 447     "-o$spec{output}"       ,
 448     $spec{source}           ,
 449   ) ];
 450 }
 451
 452 sub write_compiler_script {
 453   my ($self, %spec) = @_;
 454
 455   my $script = File::Spec->catfile( $spec{srcdir},
 456                                     $spec{basename} . '.ccs' );
 457
 458   $self->add_to_cleanup($script);
 459
 460   print "Generating script '$script'\n" if !$self->{quiet};
 461
 462   open( SCRIPT, ">$script" )
 463     or die( "Could not create script '$script': $!" );
 464
 465   # XXX Borland "response files" seem to be unable to accept macro
 466   # definitions containing quoted strings. Escaping strings with
 467   # backslash doesn't work, and any level of quotes are stripped. The
 468   # result is is a floating point number in the source file where a
 469   # string is expected. So we leave the macros on the command line.
 470   print SCRIPT join( "\n",
 471     map { ref $_ ? @{$_} : $_ }
 472     grep defined,
 473     delete(
 474       @spec{ qw(includes cflags optimize perlinc) } )
 475   );
 476
 477   close SCRIPT;
 478
 479   push @{$spec{includes}}, '@"' . $script . '"';
 480
 481   return %spec;
 482 }
 483
 484 sub format_linker_cmd {
 485   my ($self, %spec) = @_;
 486
 487   foreach my $path ( @{$spec{libpath}} ) {
 488     $path = "-L$path";
 489   }
 490
 491   push( @{$spec{startup}}, 'c0d32.obj' )
 492     unless ( $spec{starup} && @{$spec{startup}} );
 493
 494   %spec = $self->write_linker_script(%spec)
 495     if $spec{use_scripts};
 496
 497   return [ grep {defined && length} (
 498     $spec{ld}               ,
 499     @{$spec{lddlflags}}     ,
 500     @{$spec{libpath}}       ,
 501     @{$spec{other_ldflags}} ,
 502     @{$spec{startup}}       ,
 503     @{$spec{objects}}       , ',',
 504     $spec{output}           , ',',
 505     $spec{map_file}         , ',',
 506     $spec{libperl}          ,
 507     @{$spec{perllibs}}      , ',',
 508     $spec{def_file}
 509   ) ];
 510 }
 511
 512 sub write_linker_script {
 513   my ($self, %spec) = @_;
 514
 515   # To work around Borlands "unique" commandline syntax,
 516   # two scripts are used:
 517
 518   my $ld_script = File::Spec->catfile( $spec{srcdir},
 519                                        $spec{basename} . '.lds' );
 520   my $ld_libs   = File::Spec->catfile( $spec{srcdir},
 521                                        $spec{basename} . '.lbs' );
 522
 523   $self->add_to_cleanup($ld_script, $ld_libs);
 524
 525   print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
 526
 527   # Script 1: contains options & names of object files.
 528   open( LD_SCRIPT, ">$ld_script" )
 529     or die( "Could not create linker script '$ld_script': $!" );
 530
 531   print LD_SCRIPT join( " +\n",
 532     map { @{$_} }
 533     grep defined,
 534     delete(
 535       @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
 536   );
 537
 538   close LD_SCRIPT;
 539
 540   # Script 2: contains name of libs to link against.
 541   open( LD_LIBS, ">$ld_libs" )
 542     or die( "Could not create linker script '$ld_libs': $!" );
 543
 544   print LD_LIBS join( " +\n",
 545      (delete $spec{libperl}  || ''),
 546     @{delete $spec{perllibs} || []},
 547   );
 548
 549   close LD_LIBS;
 550
 551   push @{$spec{lddlflags}}, '@"' . $ld_script  . '"';
 552   push @{$spec{perllibs}},  '@"' . $ld_libs    . '"';
 553
 554   return %spec;
 555 }
 556
 557 1;
 558
 559 ########################################################################
 560 package ExtUtils::CBuilder::Platform::Windows::GCC;
 561
 562 sub format_compiler_cmd {
 563   my ($self, %spec) = @_;
 564
 565   foreach my $path ( @{ $spec{includes} || [] },
 566                      @{ $spec{perlinc}  || [] } ) {
 567     $path = '-I' . $path;
 568   }
 569
 570   # split off any -arguments included in cc
 571   my @cc = split / (?=-)/, $spec{cc};
 572
 573   return [ grep {defined && length} (
 574     @cc, '-c'               ,
 575     @{$spec{includes}}      ,
 576     @{$spec{cflags}}        ,
 577     @{$spec{optimize}}      ,
 578     @{$spec{defines}}       ,
 579     @{$spec{perlinc}}       ,
 580     '-o', $spec{output}     ,
 581     $spec{source}           ,
 582   ) ];
 583 }
 584
 585 sub format_linker_cmd {
 586   my ($self, %spec) = @_;
 587
 588   # The Config.pm variable 'libperl' is hardcoded to the full name
 589   # of the perl import library (i.e. 'libperl56.a'). GCC will not
 590   # find it unless the 'lib' prefix & the extension are stripped.
 591   $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
 592
 593   unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
 594     if ( $spec{startup} && @{$spec{startup}} );
 595
 596   # From ExtUtils::MM_Win32:
 597   #
 598   ## one thing for GCC/Mingw32:
 599   ## we try to overcome non-relocateable-DLL problems by generating
 600   ##    a (hopefully unique) image-base from the dll's name
 601   ## -- BKS, 10-19-1999
 602   File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
 603   $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
 604
 605   %spec = $self->write_linker_script(%spec)
 606     if $spec{use_scripts};
 607
 608   foreach my $path ( @{$spec{libpath}} ) {
 609     $path = "-L$path";
 610   }
 611
 612   my @cmds; # Stores the series of commands needed to build the module.
 613
 614   push @cmds, [
 615     'dlltool', '--def'        , $spec{def_file},
 616                '--output-exp' , $spec{explib}
 617   ];
 618
 619   # split off any -arguments included in ld
 620   my @ld = split / (?=-)/, $spec{ld};
 621
 622   push @cmds, [ grep {defined && length} (
 623     @ld                       ,
 624     '-o', $spec{output}       ,
 625     "-Wl,--base-file,$spec{base_file}"   ,
 626     "-Wl,--image-base,$spec{image_base}" ,
 627     @{$spec{lddlflags}}       ,
 628     @{$spec{libpath}}         ,
 629     @{$spec{startup}}         ,
 630     @{$spec{objects}}         ,
 631     @{$spec{other_ldflags}}   ,
 632     $spec{libperl}            ,
 633     @{$spec{perllibs}}        ,
 634     $spec{explib}             ,
 635     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
 636   ) ];
 637
 638   push @cmds, [
 639     'dlltool', '--def'        , $spec{def_file},
 640                '--output-exp' , $spec{explib},
 641                '--base-file'  , $spec{base_file}
 642   ];
 643
 644   push @cmds, [ grep {defined && length} (
 645     @ld                       ,
 646     '-o', $spec{output}       ,
 647     "-Wl,--image-base,$spec{image_base}" ,
 648     @{$spec{lddlflags}}       ,
 649     @{$spec{libpath}}         ,
 650     @{$spec{startup}}         ,
 651     @{$spec{objects}}         ,
 652     @{$spec{other_ldflags}}   ,
 653     $spec{libperl}            ,
 654     @{$spec{perllibs}}        ,
 655     $spec{explib}             ,
 656     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
 657   ) ];
 658
 659   return @cmds;
 660 }
 661
 662 sub write_linker_script {
 663   my ($self, %spec) = @_;
 664
 665   my $script = File::Spec->catfile( $spec{srcdir},
 666                                     $spec{basename} . '.lds' );
 667
 668   $self->add_to_cleanup($script);
 669
 670   print "Generating script '$script'\n" if !$self->{quiet};
 671
 672   open( SCRIPT, ">$script" )
 673     or die( "Could not create script '$script': $!" );
 674
 675   print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
 676     for @{delete $spec{libpath} || []};
 677
 678   # gcc takes only one startup file, so the first object in startup is
 679   # specified as the startup file and any others are shifted into the
 680   # beginning of the list of objects.
 681   if ( $spec{startup} && @{$spec{startup}} ) {
 682     print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
 683     unshift @{$spec{objects}},
 684       @{delete $spec{startup} || []};
 685   }
 686
 687   print SCRIPT 'INPUT(' . join( ',',
 688     @{delete $spec{objects}  || []}
 689   ) . ")\n";
 690
 691   print SCRIPT 'INPUT(' . join( ' ',
 692      (delete $spec{libperl}  || ''),
 693     @{delete $spec{perllibs} || []},
 694   ) . ")\n";
 695
 696   close SCRIPT;
 697
 698   push @{$spec{other_ldflags}}, '"' . $script . '"';
 699
 700   return %spec;
 701 }
 702
 703 1;
 704
 705 __END__
 706
 707 =head1 NAME
 708
 709 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
 710
 711 =head1 DESCRIPTION
 712
 713 This module implements the Windows-specific parts of ExtUtils::CBuilder.
 714 Most of the Windows-specific stuff has to do with compiling and
 715 linking C code.  Currently we support the 3 compilers perl itself
 716 supports: MSVC, BCC, and GCC.
 717
 718 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
 719 not implemented here will be implemented there.  The interfaces are
 720 defined by the L<ExtUtils::CBuilder> documentation.
 721
 722 =head1 AUTHOR
 723
 724 Ken Williams <ken@mathforum.org>
 725
 726 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
 727
 728 =head1 SEE ALSO
 729
 730 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
 731
 732 =cut