Commit | Line | Data |
---|---|---|
6b09c160 YST |
1 | package ExtUtils::CBuilder::Base; |
2 | ||
3 | use strict; | |
4 | use File::Spec; | |
5 | use File::Basename; | |
8a6e5c04 | 6 | use Cwd (); |
6b09c160 YST |
7 | use Config; |
8 | use Text::ParseWords; | |
c3fb68a3 | 9 | use IO::File; |
06e8058f CBW |
10 | use Data::Dumper;$Data::Dumper::Indent=1; |
11 | use IPC::Cmd qw(can_run); | |
12 | use File::Temp qw(tempfile); | |
6b09c160 YST |
13 | |
14 | use vars qw($VERSION); | |
a970290a | 15 | $VERSION = '0.280208'; |
06e8058f CBW |
16 | |
17 | # More details about C/C++ compilers: | |
18 | # http://developers.sun.com/sunstudio/documentation/product/compiler.jsp | |
19 | # http://gcc.gnu.org/ | |
20 | # http://publib.boulder.ibm.com/infocenter/comphelp/v101v121/index.jsp | |
21 | # http://msdn.microsoft.com/en-us/vstudio/default.aspx | |
22 | ||
23 | my %cc2cxx = ( | |
24 | # first line order is important to support wrappers like in pkgsrc | |
25 | cc => [ 'c++', 'CC', 'aCC', 'cxx', ], # Sun Studio, HP ANSI C/C++ Compilers | |
26 | gcc => [ 'g++' ], # GNU Compiler Collection | |
27 | xlc => [ 'xlC' ], # IBM C/C++ Set, xlc without thread-safety | |
28 | xlc_r => [ 'xlC_r' ], # IBM C/C++ Set, xlc with thread-safety | |
29 | cl => [ 'cl' ], # Microsoft Visual Studio | |
30 | ); | |
6b09c160 YST |
31 | |
32 | sub new { | |
33 | my $class = shift; | |
34 | my $self = bless {@_}, $class; | |
35 | ||
36 | $self->{properties}{perl} = $class->find_perl_interpreter | |
37 | or warn "Warning: Can't locate your perl binary"; | |
38 | ||
39 | while (my ($k,$v) = each %Config) { | |
40 | $self->{config}{$k} = $v unless exists $self->{config}{$k}; | |
41 | } | |
06e8058f | 42 | $self->{config}{cc} = $ENV{CC} if defined $ENV{CC}; |
011e8fb4 NT |
43 | $self->{config}{ccflags} = join(" ", $self->{config}{ccflags}, $ENV{CFLAGS}) |
44 | if defined $ENV{CFLAGS}; | |
06e8058f CBW |
45 | $self->{config}{cxx} = $ENV{CXX} if defined $ENV{CXX}; |
46 | $self->{config}{cxxflags} = $ENV{CXXFLAGS} if defined $ENV{CXXFLAGS}; | |
47 | $self->{config}{ld} = $ENV{LD} if defined $ENV{LD}; | |
011e8fb4 NT |
48 | $self->{config}{ldflags} = join(" ", $self->{config}{ldflags}, $ENV{LDFLAGS}) |
49 | if defined $ENV{LDFLAGS}; | |
06e8058f CBW |
50 | |
51 | unless ( exists $self->{config}{cxx} ) { | |
52 | my ($ccpath, $ccbase, $ccsfx ) = fileparse($self->{config}{cc}, qr/\.[^.]*/); | |
53 | foreach my $cxx (@{$cc2cxx{$ccbase}}) { | |
54 | if( can_run( File::Spec->catfile( $ccpath, $cxx, $ccsfx ) ) ) { | |
55 | $self->{config}{cxx} = File::Spec->catfile( $ccpath, $cxx, $ccsfx ); | |
56 | last; | |
57 | } | |
58 | if( can_run( File::Spec->catfile( $cxx, $ccsfx ) ) ) { | |
59 | $self->{config}{cxx} = File::Spec->catfile( $cxx, $ccsfx ); | |
60 | last; | |
61 | } | |
62 | if( can_run( $cxx ) ) { | |
63 | $self->{config}{cxx} = $cxx; | |
64 | last; | |
65 | } | |
66 | } | |
67 | unless ( exists $self->{config}{cxx} ) { | |
68 | $self->{config}{cxx} = $self->{config}{cc}; | |
d247f55d | 69 | my $cflags = $self->{config}{ccflags}; |
06e8058f CBW |
70 | $self->{config}{cxxflags} = '-x c++'; |
71 | $self->{config}{cxxflags} .= " $cflags" if defined $cflags; | |
72 | } | |
73 | } | |
74 | ||
6b09c160 YST |
75 | return $self; |
76 | } | |
77 | ||
78 | sub find_perl_interpreter { | |
79 | my $perl; | |
80 | File::Spec->file_name_is_absolute($perl = $^X) | |
81 | or -f ($perl = $Config::Config{perlpath}) | |
06e8058f | 82 | or ($perl = $^X); # XXX how about using IPC::Cmd::can_run here? |
6b09c160 YST |
83 | return $perl; |
84 | } | |
85 | ||
86 | sub add_to_cleanup { | |
87 | my $self = shift; | |
da2b6f33 SH |
88 | foreach (@_) { |
89 | $self->{files_to_clean}{$_} = 1; | |
90 | } | |
91 | } | |
92 | ||
93 | sub cleanup { | |
94 | my $self = shift; | |
95 | foreach my $file (keys %{$self->{files_to_clean}}) { | |
96 | unlink $file; | |
97 | } | |
6b09c160 YST |
98 | } |
99 | ||
06e8058f CBW |
100 | sub get_config { |
101 | return %{ $_[0]->{config} }; | |
102 | } | |
103 | ||
6b09c160 YST |
104 | sub object_file { |
105 | my ($self, $filename) = @_; | |
106 | ||
107 | # File name, minus the suffix | |
108 | (my $file_base = $filename) =~ s/\.[^.]+$//; | |
109 | return "$file_base$self->{config}{obj_ext}"; | |
110 | } | |
111 | ||
112 | sub arg_include_dirs { | |
113 | my $self = shift; | |
114 | return map {"-I$_"} @_; | |
115 | } | |
116 | ||
117 | sub arg_nolink { '-c' } | |
118 | ||
119 | sub arg_object_file { | |
120 | my ($self, $file) = @_; | |
121 | return ('-o', $file); | |
122 | } | |
123 | ||
124 | sub arg_share_object_file { | |
125 | my ($self, $file) = @_; | |
126 | return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file); | |
127 | } | |
128 | ||
129 | sub arg_exec_file { | |
130 | my ($self, $file) = @_; | |
131 | return ('-o', $file); | |
132 | } | |
133 | ||
d1cf867f SP |
134 | sub arg_defines { |
135 | my ($self, %args) = @_; | |
136 | return map "-D$_=$args{$_}", keys %args; | |
137 | } | |
138 | ||
6b09c160 YST |
139 | sub compile { |
140 | my ($self, %args) = @_; | |
141 | die "Missing 'source' argument to compile()" unless defined $args{source}; | |
142 | ||
143 | my $cf = $self->{config}; # For convenience | |
06e8058f CBW |
144 | |
145 | my $object_file = $args{object_file} | |
146 | ? $args{object_file} | |
147 | : $self->object_file($args{source}); | |
148 | ||
149 | my $include_dirs_ref = | |
150 | (exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY") | |
151 | ? [ $args{include_dirs} ] | |
152 | : $args{include_dirs}; | |
153 | my @include_dirs = $self->arg_include_dirs( | |
154 | @{ $include_dirs_ref || [] }, | |
155 | $self->perl_inc(), | |
156 | ); | |
6b09c160 | 157 | |
d1cf867f SP |
158 | my @defines = $self->arg_defines( %{$args{defines} || {}} ); |
159 | ||
06e8058f CBW |
160 | my @extra_compiler_flags = |
161 | $self->split_like_shell($args{extra_compiler_flags}); | |
6b09c160 | 162 | my @cccdlflags = $self->split_like_shell($cf->{cccdlflags}); |
06e8058f | 163 | my @ccflags = $self->split_like_shell($args{'C++'} ? $cf->{cxxflags} : $cf->{ccflags}); |
6b09c160 | 164 | my @optimize = $self->split_like_shell($cf->{optimize}); |
06e8058f CBW |
165 | my @flags = ( |
166 | @include_dirs, | |
167 | @defines, | |
168 | @cccdlflags, | |
169 | @extra_compiler_flags, | |
170 | $self->arg_nolink, | |
171 | @ccflags, | |
172 | @optimize, | |
173 | $self->arg_object_file($object_file), | |
174 | ); | |
175 | my @cc = $self->split_like_shell($args{'C++'} ? $cf->{cxx} : $cf->{cc}); | |
6b09c160 YST |
176 | |
177 | $self->do_system(@cc, @flags, $args{source}) | |
06e8058f | 178 | or die "error building $object_file from '$args{source}'"; |
6b09c160 | 179 | |
06e8058f | 180 | return $object_file; |
6b09c160 YST |
181 | } |
182 | ||
183 | sub have_compiler { | |
506098d4 | 184 | my ($self, $is_cplusplus) = @_; |
06e8058f CBW |
185 | my $have_compiler_flag = $is_cplusplus ? "have_cxx" : "have_cc"; |
186 | my $suffix = $is_cplusplus ? ".cc" : ".c"; | |
187 | return $self->{$have_compiler_flag} if defined $self->{$have_compiler_flag}; | |
6b09c160 | 188 | |
9015f106 DG |
189 | my $result; |
190 | my $attempts = 3; | |
191 | # tmpdir has issues for some people so fall back to current dir | |
9015f106 | 192 | |
06e8058f CBW |
193 | # don't clobber existing files (rare, but possible) |
194 | my ( $FH, $tmpfile ) = tempfile( "compilet-XXXXX", SUFFIX => $suffix ); | |
195 | binmode $FH; | |
9015f106 | 196 | |
06e8058f CBW |
197 | if ( $is_cplusplus ) { |
198 | print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n"; | |
199 | } | |
200 | else { | |
201 | print $FH "int boot_compilet() { return 1; }\n"; | |
202 | } | |
ef9721fc | 203 | close $FH; |
06e8058f CBW |
204 | |
205 | my ($obj_file, @lib_files); | |
206 | eval { | |
207 | local $^W = 0; | |
208 | local $self->{quiet} = 1; | |
209 | $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile); | |
210 | @lib_files = $self->link(objects => $obj_file, module_name => 'compilet'); | |
211 | }; | |
212 | $result = $@ ? 0 : 1; | |
213 | ||
214 | foreach (grep defined, $tmpfile, $obj_file, @lib_files) { | |
215 | 1 while unlink; | |
6b09c160 | 216 | } |
9015f106 | 217 | |
06e8058f | 218 | return $self->{$have_compiler_flag} = $result; |
6b09c160 YST |
219 | } |
220 | ||
506098d4 DG |
221 | sub have_cplusplus { |
222 | push @_, 1; | |
223 | goto &have_compiler; | |
224 | } | |
225 | ||
6b09c160 YST |
226 | sub lib_file { |
227 | my ($self, $dl_file) = @_; | |
228 | $dl_file =~ s/\.[^.]+$//; | |
229 | $dl_file =~ tr/"//d; | |
230 | return "$dl_file.$self->{config}{dlext}"; | |
231 | } | |
232 | ||
233 | ||
234 | sub exe_file { | |
235 | my ($self, $dl_file) = @_; | |
236 | $dl_file =~ s/\.[^.]+$//; | |
237 | $dl_file =~ tr/"//d; | |
238 | return "$dl_file$self->{config}{_exe}"; | |
239 | } | |
240 | ||
241 | sub need_prelink { 0 } | |
242 | ||
d1cf867f SP |
243 | sub extra_link_args_after_prelink { return } |
244 | ||
6b09c160 YST |
245 | sub prelink { |
246 | my ($self, %args) = @_; | |
06e8058f CBW |
247 | |
248 | my ($dl_file_out, $mksymlists_args) = _prepare_mksymlists_args(\%args); | |
249 | ||
6b09c160 | 250 | require ExtUtils::Mksymlists; |
06e8058f CBW |
251 | # dl. abbrev for dynamic library |
252 | ExtUtils::Mksymlists::Mksymlists( %{ $mksymlists_args } ); | |
253 | ||
6b09c160 | 254 | # Mksymlists will create one of these files |
06e8058f CBW |
255 | return grep -e, map "$dl_file_out.$_", qw(ext def opt); |
256 | } | |
257 | ||
258 | sub _prepare_mksymlists_args { | |
259 | my $args = shift; | |
260 | ($args->{dl_file} = $args->{dl_name}) =~ s/.*::// unless $args->{dl_file}; | |
261 | ||
262 | my %mksymlists_args = ( | |
263 | DL_VARS => $args->{dl_vars} || [], | |
264 | DL_FUNCS => $args->{dl_funcs} || {}, | |
265 | FUNCLIST => $args->{dl_func_list} || [], | |
266 | IMPORTS => $args->{dl_imports} || {}, | |
267 | NAME => $args->{dl_name}, # Name of the Perl module | |
268 | DLBASE => $args->{dl_base}, # Basename of DLL file | |
269 | FILE => $args->{dl_file}, # Dir + Basename of symlist file | |
270 | VERSION => (defined $args->{dl_version} ? $args->{dl_version} : '0.0'), | |
271 | ); | |
272 | return ($args->{dl_file}, \%mksymlists_args); | |
6b09c160 YST |
273 | } |
274 | ||
275 | sub link { | |
276 | my ($self, %args) = @_; | |
277 | return $self->_do_link('lib_file', lddl => 1, %args); | |
278 | } | |
279 | ||
280 | sub link_executable { | |
281 | my ($self, %args) = @_; | |
282 | return $self->_do_link('exe_file', lddl => 0, %args); | |
283 | } | |
2bd31f1a | 284 | |
6b09c160 YST |
285 | sub _do_link { |
286 | my ($self, $type, %args) = @_; | |
287 | ||
288 | my $cf = $self->{config}; # For convenience | |
289 | ||
290 | my $objects = delete $args{objects}; | |
291 | $objects = [$objects] unless ref $objects; | |
292 | my $out = $args{$type} || $self->$type($objects->[0]); | |
293 | ||
294 | my @temp_files; | |
295 | @temp_files = | |
06e8058f CBW |
296 | $self->prelink(%args, dl_name => $args{module_name}) |
297 | if $args{lddl} && $self->need_prelink; | |
6b09c160 | 298 | |
06e8058f CBW |
299 | my @linker_flags = ( |
300 | $self->split_like_shell($args{extra_linker_flags}), | |
301 | $self->extra_link_args_after_prelink( | |
302 | %args, dl_name => $args{module_name}, prelink_res => \@temp_files | |
303 | ) | |
304 | ); | |
d1cf867f | 305 | |
06e8058f CBW |
306 | my @output = $args{lddl} |
307 | ? $self->arg_share_object_file($out) | |
308 | : $self->arg_exec_file($out); | |
6b09c160 YST |
309 | my @shrp = $self->split_like_shell($cf->{shrpenv}); |
310 | my @ld = $self->split_like_shell($cf->{ld}); | |
2bd31f1a | 311 | |
6b09c160 YST |
312 | $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags) |
313 | or die "error building $out from @$objects"; | |
314 | ||
315 | return wantarray ? ($out, @temp_files) : $out; | |
316 | } | |
317 | ||
318 | ||
319 | sub do_system { | |
320 | my ($self, @cmd) = @_; | |
321 | print "@cmd\n" if !$self->{quiet}; | |
322 | return !system(@cmd); | |
323 | } | |
324 | ||
325 | sub split_like_shell { | |
326 | my ($self, $string) = @_; | |
327 | ||
328 | return () unless defined($string); | |
329 | return @$string if UNIVERSAL::isa($string, 'ARRAY'); | |
330 | $string =~ s/^\s+|\s+$//g; | |
331 | return () unless length($string); | |
332 | ||
06e8058f CBW |
333 | # Text::ParseWords replaces all 'escaped' characters with themselves, which completely |
334 | # breaks paths under windows. As such, we forcibly replace backwards slashes with forward | |
335 | # slashes on windows. | |
336 | $string =~ s@\\@/@g if $^O eq 'MSWin32'; | |
337 | ||
6b09c160 YST |
338 | return Text::ParseWords::shellwords($string); |
339 | } | |
340 | ||
341 | # if building perl, perl's main source directory | |
342 | sub perl_src { | |
343 | # N.B. makemaker actually searches regardless of PERL_CORE, but | |
344 | # only squawks at not finding it if PERL_CORE is set | |
345 | ||
345dbb93 RGS |
346 | return unless $ENV{PERL_CORE}; |
347 | ||
ea2e6518 RGS |
348 | my $Updir = File::Spec->updir; |
349 | my $dir = File::Spec->curdir; | |
345dbb93 RGS |
350 | |
351 | # Try up to 5 levels upwards | |
33d1b122 | 352 | for (0..10) { |
345dbb93 | 353 | if ( |
06e8058f CBW |
354 | -f File::Spec->catfile($dir,"config_h.SH") |
355 | && | |
356 | -f File::Spec->catfile($dir,"perl.h") | |
357 | && | |
358 | -f File::Spec->catfile($dir,"lib","Exporter.pm") | |
359 | ) { | |
8a6e5c04 | 360 | return Cwd::realpath( $dir ); |
6b09c160 YST |
361 | } |
362 | ||
345dbb93 | 363 | $dir = File::Spec->catdir($dir, $Updir); |
6b09c160 | 364 | } |
ea2e6518 | 365 | |
345dbb93 | 366 | warn "PERL_CORE is set but I can't find your perl source!\n"; |
ea2e6518 | 367 | return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ??? |
6b09c160 YST |
368 | } |
369 | ||
370 | # directory of perl's include files | |
371 | sub perl_inc { | |
372 | my $self = shift; | |
373 | ||
374 | $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE"); | |
375 | } | |
376 | ||
da2b6f33 SH |
377 | sub DESTROY { |
378 | my $self = shift; | |
8a6e5c04 | 379 | local($., $@, $!, $^E, $?); |
da2b6f33 SH |
380 | $self->cleanup(); |
381 | } | |
382 | ||
6b09c160 | 383 | 1; |
06e8058f CBW |
384 | |
385 | # vim: ts=2 sw=2 et: |