1package ExtUtils::CBuilder::Platform::Windows; 2use strict; 3use warnings; 4 5use File::Basename; 6use File::Spec; 7 8use ExtUtils::CBuilder::Base; 9use IO::File; 10 11our $VERSION = '0.280231'; # VERSION 12our @ISA = qw(ExtUtils::CBuilder::Base); 13 14=begin comment 15 16The compiler-specific packages implement functions for generating properly 17formatted commandlines for the compiler being used. Each package 18defines two primary functions 'format_linker_cmd()' & 19'format_compiler_cmd()' that accepts a list of named arguments (a 20hash) and returns a list of formatted options suitable for invoking the 21compiler. By default, if the compiler supports scripting of its 22operation then a script file is built containing the options while 23those options are removed from the commandline, and a reference to the 24script is pushed onto the commandline in their place. Scripting the 25compiler in this way helps to avoid the problems associated with long 26commandlines under some shells. 27 28=end comment 29 30=cut 31 32sub 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 45sub _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 54sub 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 65sub 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 75sub arg_defines { 76 my ($self, %args) = @_; 77 s/"/\\"/g foreach values %args; 78 return map qq{"-D$_=$args{$_}"}, sort keys %args; 79} 80 81sub 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 136sub need_prelink { 1 } 137 138sub 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 230sub 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 248sub 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 2601; 261 262__END__ 263 264=head1 NAME 265 266ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms 267 268=head1 DESCRIPTION 269 270This module implements the Windows-specific parts of ExtUtils::CBuilder. 271Most of the Windows-specific stuff has to do with compiling and 272linking C code. Currently we support the 3 compilers perl itself 273supports: MSVC, BCC, and GCC. 274 275This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality 276not implemented here will be implemented there. The interfaces are 277defined by the L<ExtUtils::CBuilder> documentation. 278 279=head1 AUTHOR 280 281Ken Williams <ken@mathforum.org> 282 283Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>. 284 285=head1 SEE ALSO 286 287perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3) 288 289=cut 290