dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm

   1 package ExtUtils::CBuilder::Platform::Windows;
   2 use strict;
   3 use warnings;
   4
   5 use File::Basename;
   6 use File::Spec;
   7
   8 use ExtUtils::CBuilder::Base;
   9 use IO::File;
  10
  11 our $VERSION = '0.280230'; # VERSION
  12 our @ISA = qw(ExtUtils::CBuilder::Base);
  13
  14 =begin comment
  15
  16 The compiler-specific packages implement functions for generating properly
  17 formatted commandlines for the compiler being used. Each package
  18 defines two primary functions 'format_linker_cmd()' &
  19 'format_compiler_cmd()' that accepts a list of named arguments (a
  20 hash) and returns a list of formatted options suitable for invoking the
  21 compiler. By default, if the compiler supports scripting of its
  22 operation then a script file is built containing the options while
  23 those options are removed from the commandline, and a reference to the
  24 script is pushed onto the commandline in their place. Scripting the
  25 compiler in this way helps to avoid the problems associated with long
  26 commandlines under some shells.
  27
  28 =end comment
  29
  30 =cut
  31
  32 sub new {
  33   my $class = shift;
  34   my $self = $class->SUPER::new(@_);
  35   my $cf = $self->{config};
  36
  37   # Inherit from an appropriate compiler driver class
  38   my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
  39   eval "require $driver" or die "Could not load compiler driver: $@";
  40   unshift @ISA, $driver;
  41
  42   return $self;
  43 }
  44
  45 sub _compiler_type {
  46   my $self = shift;
  47   my $cc = $self->{config}{cc};
  48
  49   return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
  50           : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
  51           : 'GCC');
  52 }
  53
  54 sub split_like_shell {
  55   # Since Windows will pass the whole command string (not an argument
  56   # array) to the target program and make the program parse it itself,
  57   # we don't actually need to do any processing here.
  58   (my $self, local $_) = @_;
  59
  60   return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
  61   return unless defined() && length();
  62   return ($_);
  63 }
  64
  65 sub do_system {
  66   # See above
  67   my $self = shift;
  68   my $cmd = join(" ",
  69                  grep length,
  70                  map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a}
  71                  grep defined, @_);
  72   return $self->SUPER::do_system($cmd);
  73 }
  74
  75 sub arg_defines {
  76   my ($self, %args) = @_;
  77   s/"/\\"/g foreach values %args;
  78   return map qq{"-D$_=$args{$_}"}, sort keys %args;
  79 }
  80
  81 sub compile {
  82   my ($self, %args) = @_;
  83   my $cf = $self->{config};
  84
  85   die "Missing 'source' argument to compile()" unless defined $args{source};
  86
  87   $args{include_dirs} = [ $args{include_dirs} ]
  88     if exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY";
  89
  90   my ($basename, $srcdir) =
  91     ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
  92
  93   $srcdir ||= File::Spec->curdir();
  94
  95   my @defines = $self->arg_defines( %{ $args{defines} || {} } );
  96
  97   my %spec = (
  98     srcdir      => $srcdir,
  99     builddir    => $srcdir,
 100     basename    => $basename,
 101     source      => $args{source},
 102     output      => $args{object_file} || File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
 103     cc          => $cf->{cc},
 104     cflags      => [
 105                      $self->split_like_shell($cf->{ccflags}),
 106                      $self->split_like_shell($cf->{cccdlflags}),
 107                      $self->split_like_shell($args{extra_compiler_flags}),
 108                    ],
 109     optimize    => [ $self->split_like_shell($cf->{optimize})    ],
 110     defines     => \@defines,
 111     includes    => [ @{$args{include_dirs} || []} ],
 112     perlinc     => [
 113                      $self->perl_inc(),
 114                      $self->split_like_shell($cf->{incpath}),
 115                    ],
 116     use_scripts => 1, # XXX provide user option to change this???
 117   );
 118
 119   $self->normalize_filespecs(
 120     \$spec{source},
 121     \$spec{output},
 122      $spec{includes},
 123      $spec{perlinc},
 124   );
 125
 126   my @cmds = $self->format_compiler_cmd(%spec);
 127   while ( my $cmd = shift @cmds ) {
 128     $self->do_system( @$cmd )
 129       or die "error building $cf->{dlext} file from '$args{source}'";
 130   }
 131
 132   (my $out = $spec{output}) =~ tr/'"//d;
 133   return $out;
 134 }
 135
 136 sub need_prelink { 1 }
 137
 138 sub link {
 139   my ($self, %args) = @_;
 140   my $cf = $self->{config};
 141
 142   my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
 143   my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
 144   $to ||= File::Spec->curdir();
 145
 146   (my $file_base = $args{module_name}) =~ s/.*:://;
 147   my $output = $args{lib_file} ||
 148     File::Spec->catfile($to, "$file_base.$cf->{dlext}");
 149
 150   # if running in perl source tree, look for libs there, not installed
 151   my $lddlflags = $cf->{lddlflags};
 152   my $perl_src = $self->perl_src();
 153   $lddlflags =~ s{\Q$cf->{archlibexp}\E[\\/]CORE}{$perl_src/lib/CORE} if $perl_src;
 154
 155   my %spec = (
 156     srcdir        => $to,
 157     builddir      => $to,
 158     startup       => [ ],
 159     objects       => \@objects,
 160     libs          => [ ],
 161     output        => $output,
 162     ld            => $cf->{ld},
 163     libperl       => $cf->{libperl},
 164     perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
 165     libpath       => [ $self->split_like_shell($cf->{libpth})    ],
 166     lddlflags     => [ $self->split_like_shell($lddlflags) ],
 167     other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
 168     use_scripts   => 1, # XXX provide user option to change this???
 169   );
 170
 171   unless ( $spec{basename} ) {
 172     ($spec{basename} = $args{module_name}) =~ s/.*:://;
 173   }
 174
 175   $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
 176   $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
 177
 178   $spec{output}    ||= File::Spec->catfile( $spec{builddir},
 179                                             $spec{basename}  . '.'.$cf->{dlext}   );
 180   $spec{manifest}  ||= $spec{output} . '.manifest';
 181   $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
 182                                             $spec{basename}  . $cf->{lib_ext} );
 183   $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
 184                                             $spec{basename}  . '.exp'  );
 185   if ($cf->{cc} eq 'cl') {
 186     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
 187                                             $spec{basename}  . '.pdb'  );
 188   }
 189   elsif ($cf->{cc} eq 'bcc32') {
 190     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
 191                                             $spec{basename}  . '.tds'  );
 192   }
 193   $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
 194                                             $spec{basename}  . '.def'  );
 195   $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
 196                                             $spec{basename}  . '.base' );
 197
 198   $self->add_to_cleanup(
 199     grep defined,
 200     @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
 201   );
 202
 203   foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
 204     $self->normalize_filespecs( \$spec{$opt} );
 205   }
 206
 207   foreach my $opt ( qw(libpath startup objects) ) {
 208     $self->normalize_filespecs( $spec{$opt} );
 209   }
 210
 211   (my $def_base = $spec{def_file}) =~ tr/'"//d;
 212   $def_base =~ s/\.def$//;
 213   $self->prelink( %args,
 214                   dl_name => $args{module_name},
 215                   dl_file => $def_base,
 216                   dl_base => $spec{basename} );
 217
 218   my @cmds = $self->format_linker_cmd(%spec);
 219   while ( my $cmd = shift @cmds ) {
 220     $self->do_system( @$cmd );
 221   }
 222
 223   $spec{output} =~ tr/'"//d;
 224   return wantarray
 225     ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
 226     : $spec{output};
 227 }
 228
 229 # canonize & quote paths
 230 sub normalize_filespecs {
 231   my ($self, @specs) = @_;
 232   foreach my $spec ( grep defined, @specs ) {
 233     if ( ref $spec eq 'ARRAY') {
 234       $self->normalize_filespecs( map {\$_} grep defined, @$spec )
 235     } elsif ( ref $spec eq 'SCALAR' ) {
 236       $$spec =~ tr/"//d if $$spec;
 237       next unless $$spec;
 238       $$spec = '"' . File::Spec->canonpath($$spec) . '"';
 239     } elsif ( ref $spec eq '' ) {
 240       $spec = '"' . File::Spec->canonpath($spec) . '"';
 241     } else {
 242       die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
 243     }
 244   }
 245 }
 246
 247 # directory of perl's include files
 248 sub perl_inc {
 249   my $self = shift;
 250
 251   my $perl_src = $self->perl_src();
 252
 253   if ($perl_src) {
 254     File::Spec->catdir($perl_src, "lib", "CORE");
 255   } else {
 256     File::Spec->catdir($self->{config}{archlibexp},"CORE");
 257   }
 258 }
 259
 260 1;
 261
 262 __END__
 263
 264 =head1 NAME
 265
 266 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
 267
 268 =head1 DESCRIPTION
 269
 270 This module implements the Windows-specific parts of ExtUtils::CBuilder.
 271 Most of the Windows-specific stuff has to do with compiling and
 272 linking C code.  Currently we support the 3 compilers perl itself
 273 supports: MSVC, BCC, and GCC.
 274
 275 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
 276 not implemented here will be implemented there.  The interfaces are
 277 defined by the L<ExtUtils::CBuilder> documentation.
 278
 279 =head1 AUTHOR
 280
 281 Ken Williams <ken@mathforum.org>
 282
 283 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
 284
 285 =head1 SEE ALSO
 286
 287 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
 288
 289 =cut