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