local-lib5/lib/perl5/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.27';
  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   my ($basename, $srcdir) =
  90     ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
  91
  92   $srcdir ||= File::Spec->curdir();
  93
  94   my @defines = $self->arg_defines( %{ $args{defines} || {} } );
  95
  96   my %spec = (
  97     srcdir      => $srcdir,
  98     builddir    => $srcdir,
  99     basename    => $basename,
 100     source      => $args{source},
 101     output      => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
 102     cc          => $cf->{cc},
 103     cflags      => [
 104                      $self->split_like_shell($cf->{ccflags}),
 105                      $self->split_like_shell($cf->{cccdlflags}),
 106                      $self->split_like_shell($args{extra_compiler_flags}),
 107                    ],
 108     optimize    => [ $self->split_like_shell($cf->{optimize})    ],
 109     defines     => \@defines,
 110     includes    => [ @{$args{include_dirs} || []} ],
 111     perlinc     => [
 112                      $self->perl_inc(),
 113                      $self->split_like_shell($cf->{incpath}),
 114                    ],
 115     use_scripts => 1, # XXX provide user option to change this???
 116   );
 117
 118   $self->normalize_filespecs(
 119     \$spec{source},
 120     \$spec{output},
 121      $spec{includes},
 122      $spec{perlinc},
 123   );
 124
 125   my @cmds = $self->format_compiler_cmd(%spec);
 126   while ( my $cmd = shift @cmds ) {
 127     $self->do_system( @$cmd )
 128       or die "error building $cf->{dlext} file from '$args{source}'";
 129   }
 130
 131   (my $out = $spec{output}) =~ tr/'"//d;
 132   return $out;
 133 }
 134
 135 sub need_prelink { 1 }
 136
 137 sub link {
 138   my ($self, %args) = @_;
 139   my $cf = $self->{config};
 140
 141   my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
 142   my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
 143   $to ||= File::Spec->curdir();
 144
 145   (my $file_base = $args{module_name}) =~ s/.*:://;
 146   my $output = $args{lib_file} ||
 147     File::Spec->catfile($to, "$file_base.$cf->{dlext}");
 148
 149   # if running in perl source tree, look for libs there, not installed
 150   my $lddlflags = $cf->{lddlflags};
 151   my $perl_src = $self->perl_src();
 152   $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
 153
 154   my %spec = (
 155     srcdir        => $to,
 156     builddir      => $to,
 157     startup       => [ ],
 158     objects       => \@objects,
 159     libs          => [ ],
 160     output        => $output,
 161     ld            => $cf->{ld},
 162     libperl       => $cf->{libperl},
 163     perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
 164     libpath       => [ $self->split_like_shell($cf->{libpth})    ],
 165     lddlflags     => [ $self->split_like_shell($lddlflags) ],
 166     other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
 167     use_scripts   => 1, # XXX provide user option to change this???
 168   );
 169
 170   unless ( $spec{basename} ) {
 171     ($spec{basename} = $args{module_name}) =~ s/.*:://;
 172   }
 173
 174   $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
 175   $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
 176
 177   $spec{output}    ||= File::Spec->catfile( $spec{builddir},
 178                                             $spec{basename}  . '.'.$cf->{dlext}   );
 179   $spec{manifest}  ||= File::Spec->catfile( $spec{builddir},
 180                                             $spec{basename}  . '.'.$cf->{dlext}.'.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( dl_name => $args{module_name},
 214                   dl_file => $def_base,
 215                   dl_base => $spec{basename} );
 216
 217   my @cmds = $self->format_linker_cmd(%spec);
 218   while ( my $cmd = shift @cmds ) {
 219     $self->do_system( @$cmd );
 220   }
 221
 222   $spec{output} =~ tr/'"//d;
 223   return wantarray
 224     ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
 225     : $spec{output};
 226 }
 227
 228 # canonize & quote paths
 229 sub normalize_filespecs {
 230   my ($self, @specs) = @_;
 231   foreach my $spec ( grep defined, @specs ) {
 232     if ( ref $spec eq 'ARRAY') {
 233       $self->normalize_filespecs( map {\$_} grep defined, @$spec )
 234     } elsif ( ref $spec eq 'SCALAR' ) {
 235       $$spec =~ tr/"//d if $$spec;
 236       next unless $$spec;
 237       $$spec = '"' . File::Spec->canonpath($$spec) . '"';
 238     } elsif ( ref $spec eq '' ) {
 239       $spec = '"' . File::Spec->canonpath($spec) . '"';
 240     } else {
 241       die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
 242     }
 243   }
 244 }
 245
 246 # directory of perl's include files
 247 sub perl_inc {
 248   my $self = shift;
 249
 250   my $perl_src = $self->perl_src();
 251
 252   if ($perl_src) {
 253     File::Spec->catdir($perl_src, "lib", "CORE");
 254   } else {
 255     File::Spec->catdir($self->{config}{archlibexp},"CORE");
 256   }
 257 }
 258
 259 1;
 260
 261 __END__
 262
 263 =head1 NAME
 264
 265 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
 266
 267 =head1 DESCRIPTION
 268
 269 This module implements the Windows-specific parts of ExtUtils::CBuilder.
 270 Most of the Windows-specific stuff has to do with compiling and
 271 linking C code.  Currently we support the 3 compilers perl itself
 272 supports: MSVC, BCC, and GCC.
 273
 274 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
 275 not implemented here will be implemented there.  The interfaces are
 276 defined by the L<ExtUtils::CBuilder> documentation.
 277
 278 =head1 AUTHOR
 279
 280 Ken Williams <ken@mathforum.org>
 281
 282 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
 283
 284 =head1 SEE ALSO
 285
 286 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
 287
 288 =cut