This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2ff44b674e9381abeabeb64724ff1936858f94e7
[perl5.git] / dist / ExtUtils-CBuilder / lib / ExtUtils / CBuilder / Platform / Windows.pm
1 package ExtUtils::CBuilder::Platform::Windows;
2 $ExtUtils::CBuilder::Platform::Windows::VERSION = '0.280226';
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`/lib/CORE} 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