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

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