<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package ExtUtils::CBuilder::Platform::Windows;
use strict;
use warnings;

use File::Basename;
use File::Spec;

use ExtUtils::CBuilder::Base;
use IO::File;

our $VERSION = '0.280236'; # VERSION
our @ISA = qw(ExtUtils::CBuilder::Base);

=begin comment

The compiler-specific packages implement functions for generating properly
formatted commandlines for the compiler being used. Each package
defines two primary functions 'format_linker_cmd()' &amp;
'format_compiler_cmd()' that accepts a list of named arguments (a
hash) and returns a list of formatted options suitable for invoking the
compiler. By default, if the compiler supports scripting of its
operation then a script file is built containing the options while
those options are removed from the commandline, and a reference to the
script is pushed onto the commandline in their place. Scripting the
compiler in this way helps to avoid the problems associated with long
commandlines under some shells.

=end comment

=cut

sub new {
  my $class = shift;
  my $self = $class-&gt;SUPER::new(@_);
  my $cf = $self-&gt;{config};

  # Inherit from an appropriate compiler driver class
  my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self-&gt;_compiler_type;
  eval "require $driver" or die "Could not load compiler driver: $@";
  unshift @ISA, $driver;

  return $self;
}

sub _compiler_type {
  my $self = shift;
  my $cc = $self-&gt;{config}{cc};

  return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
	  : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
	  : 'GCC');
}

sub split_like_shell {
  # Since Windows will pass the whole command string (not an argument
  # array) to the target program and make the program parse it itself,
  # we don't actually need to do any processing here.
  (my $self, local $_) = @_;

  return @$_ if defined() &amp;&amp; UNIVERSAL::isa($_, 'ARRAY');
  return unless defined() &amp;&amp; length();
  return ($_);
}

sub do_system {
  # See above
  my $self = shift;
  my $cmd = join(" ",
		 grep length,
		 map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a}
		 grep defined, @_);
  return $self-&gt;SUPER::do_system($cmd);
}

sub arg_defines {
  my ($self, %args) = @_;
  s/"/\\"/g foreach values %args;
  return map qq{"-D$_=$args{$_}"}, sort keys %args;
}

sub compile {
  my ($self, %args) = @_;
  my $cf = $self-&gt;{config};

  die "Missing 'source' argument to compile()" unless defined $args{source};

  $args{include_dirs} = [ $args{include_dirs} ]
    if exists($args{include_dirs}) &amp;&amp; ref($args{include_dirs}) ne "ARRAY";

  my ($basename, $srcdir) =
    ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];

  $srcdir ||= File::Spec-&gt;curdir();

  my @defines = $self-&gt;arg_defines( %{ $args{defines} || {} } );

  my %spec = (
    srcdir      =&gt; $srcdir,
    builddir    =&gt; $srcdir,
    basename    =&gt; $basename,
    source      =&gt; $args{source},
    output      =&gt; $args{object_file} || File::Spec-&gt;catfile($srcdir, $basename) . $cf-&gt;{obj_ext},
    cc          =&gt; $cf-&gt;{cc},
    cflags      =&gt; [
                     $self-&gt;split_like_shell($cf-&gt;{ccflags}),
                     $self-&gt;split_like_shell($cf-&gt;{cccdlflags}),
                     $self-&gt;split_like_shell($args{extra_compiler_flags}),
                   ],
    optimize    =&gt; [ $self-&gt;split_like_shell($cf-&gt;{optimize})    ],
    defines     =&gt; \@defines,
    includes    =&gt; [ @{$args{include_dirs} || []} ],
    perlinc     =&gt; [
                     $self-&gt;perl_inc(),
                     $self-&gt;split_like_shell($cf-&gt;{incpath}),
                   ],
    use_scripts =&gt; 1, # XXX provide user option to change this???
  );

  $self-&gt;normalize_filespecs(
    \$spec{source},
    \$spec{output},
     $spec{includes},
     $spec{perlinc},
  );

  my @cmds = $self-&gt;format_compiler_cmd(%spec);
  while ( my $cmd = shift @cmds ) {
    $self-&gt;do_system( @$cmd )
      or die "error building $cf-&gt;{dlext} file from '$args{source}'";
  }

  (my $out = $spec{output}) =~ tr/'"//d;
  return $out;
}

sub need_prelink { 1 }

sub link {
  my ($self, %args) = @_;
  my $cf = $self-&gt;{config};

  my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
  my $to = join '', (File::Spec-&gt;splitpath($objects[0]))[0,1];
  $to ||= File::Spec-&gt;curdir();

  (my $file_base = $args{module_name}) =~ s/.*:://;
  my $output = $args{lib_file} ||
    File::Spec-&gt;catfile($to, "$file_base.$cf-&gt;{dlext}");

  # if running in perl source tree, look for libs there, not installed
  my $lddlflags = $cf-&gt;{lddlflags};
  my $perl_src = $self-&gt;perl_src();
  $lddlflags =~ s{\Q$cf-&gt;{archlibexp}\E[\\/]CORE}{$perl_src/lib/CORE} if $perl_src;

  my %spec = (
    srcdir        =&gt; $to,
    builddir      =&gt; $to,
    startup       =&gt; [ ],
    objects       =&gt; \@objects,
    libs          =&gt; [ ],
    output        =&gt; $output,
    ld            =&gt; $cf-&gt;{ld},
    libperl       =&gt; $cf-&gt;{libperl},
    perllibs      =&gt; [ $self-&gt;split_like_shell($cf-&gt;{perllibs})  ],
    libpath       =&gt; [ $self-&gt;split_like_shell($cf-&gt;{libpth})    ],
    lddlflags     =&gt; [ $self-&gt;split_like_shell($lddlflags) ],
    other_ldflags =&gt; [ $self-&gt;split_like_shell($args{extra_linker_flags} || '') ],
    use_scripts   =&gt; 1, # XXX provide user option to change this???
  );

  unless ( $spec{basename} ) {
    ($spec{basename} = $args{module_name}) =~ s/.*:://;
  }

  $spec{srcdir}   = File::Spec-&gt;canonpath( $spec{srcdir}   );
  $spec{builddir} = File::Spec-&gt;canonpath( $spec{builddir} );

  $spec{output}    ||= File::Spec-&gt;catfile( $spec{builddir},
                                            $spec{basename}  . '.'.$cf-&gt;{dlext}   );
  $spec{manifest}  ||= $spec{output} . '.manifest';
  $spec{implib}    ||= File::Spec-&gt;catfile( $spec{builddir},
                                            $spec{basename}  . $cf-&gt;{lib_ext} );
  $spec{explib}    ||= File::Spec-&gt;catfile( $spec{builddir},
                                            $spec{basename}  . '.exp'  );
  if ($cf-&gt;{cc} eq 'cl') {
    $spec{dbg_file}  ||= File::Spec-&gt;catfile( $spec{builddir},
                                            $spec{basename}  . '.pdb'  );
  }
  elsif ($cf-&gt;{cc} eq 'bcc32') {
    $spec{dbg_file}  ||= File::Spec-&gt;catfile( $spec{builddir},
                                            $spec{basename}  . '.tds'  );
  }
  $spec{def_file}  ||= File::Spec-&gt;catfile( $spec{srcdir}  ,
                                            $spec{basename}  . '.def'  );
  $spec{base_file} ||= File::Spec-&gt;catfile( $spec{srcdir}  ,
                                            $spec{basename}  . '.base' );

  $self-&gt;add_to_cleanup(
    grep defined,
    @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
  );

  foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
    $self-&gt;normalize_filespecs( \$spec{$opt} );
  }

  foreach my $opt ( qw(libpath startup objects) ) {
    $self-&gt;normalize_filespecs( $spec{$opt} );
  }

  (my $def_base = $spec{def_file}) =~ tr/'"//d;
  $def_base =~ s/\.def$//;
  $self-&gt;prelink( %args,
                  dl_name =&gt; $args{module_name},
                  dl_file =&gt; $def_base,
                  dl_base =&gt; $spec{basename} );

  my @cmds = $self-&gt;format_linker_cmd(%spec);
  while ( my $cmd = shift @cmds ) {
    $self-&gt;do_system( @$cmd );
  }

  $spec{output} =~ tr/'"//d;
  return wantarray
    ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
    : $spec{output};
}

# canonize &amp; quote paths
sub normalize_filespecs {
  my ($self, @specs) = @_;
  foreach my $spec ( grep defined, @specs ) {
    if ( ref $spec eq 'ARRAY') {
      $self-&gt;normalize_filespecs( map {\$_} grep defined, @$spec )
    } elsif ( ref $spec eq 'SCALAR' ) {
      $$spec =~ tr/"//d if $$spec;
      next unless $$spec;
      $$spec = '"' . File::Spec-&gt;canonpath($$spec) . '"';
    } elsif ( ref $spec eq '' ) {
      $spec = '"' . File::Spec-&gt;canonpath($spec) . '"';
    } else {
      die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
    }
  }
}

# directory of perl's include files
sub perl_inc {
  my $self = shift;

  my $perl_src = $self-&gt;perl_src();

  if ($perl_src) {
    File::Spec-&gt;catdir($perl_src, "lib", "CORE");
  } else {
    File::Spec-&gt;catdir($self-&gt;{config}{archlibexp},"CORE");
  }
}

1;

__END__

=head1 NAME

ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms

=head1 DESCRIPTION

This module implements the Windows-specific parts of ExtUtils::CBuilder.
Most of the Windows-specific stuff has to do with compiling and
linking C code.  Currently we support the 3 compilers perl itself
supports: MSVC, BCC, and GCC.

This module inherits from C&lt;ExtUtils::CBuilder::Base&gt;, so any functionality
not implemented here will be implemented there.  The interfaces are
defined by the L&lt;ExtUtils::CBuilder&gt; documentation.

=head1 AUTHOR

Ken Williams &lt;ken@mathforum.org&gt;

Most of the code here was written by Randy W. Sims &lt;RandyS@ThePierianSpring.org&gt;.

=head1 SEE ALSO

perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)

=cut
</pre></body></html>