Statistics
| Branch: | Tag: | Revision:

root / tools / perl / lib / ExtUtils / CBuilder / Platform / Windows.pm @ fa47cac2

History | View | Annotate | Download (8.8 kB)

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.2703';
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      => 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