This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump ExtUtils-CBuilder version for blead change
[perl5.git] / 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.280201';
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}  ||= File::Spec->catfile( $spec{builddir},
183                                             $spec{basename}  . '.'.$cf->{dlext}.'.manifest');
184   $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
185                                             $spec{basename}  . $cf->{lib_ext} );
186   $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
187                                             $spec{basename}  . '.exp'  );
188   if ($cf->{cc} eq 'cl') {
189     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
190                                             $spec{basename}  . '.pdb'  );
191   }
192   elsif ($cf->{cc} eq 'bcc32') {
193     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
194                                             $spec{basename}  . '.tds'  );
195   }
196   $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
197                                             $spec{basename}  . '.def'  );
198   $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
199                                             $spec{basename}  . '.base' );
200
201   $self->add_to_cleanup(
202     grep defined,
203     @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
204   );
205
206   foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
207     $self->normalize_filespecs( \$spec{$opt} );
208   }
209
210   foreach my $opt ( qw(libpath startup objects) ) {
211     $self->normalize_filespecs( $spec{$opt} );
212   }
213
214   (my $def_base = $spec{def_file}) =~ tr/'"//d;
215   $def_base =~ s/\.def$//;
216   $self->prelink( 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