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