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