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