Bump $ExtUtils::CBuilder::VERSION and add Changes entry for prelink() fix
[perl.git] / dist / ExtUtils-CBuilder / lib / ExtUtils / CBuilder / Base.pm
1 package ExtUtils::CBuilder::Base;
2
3 use strict;
4 use File::Spec;
5 use File::Basename;
6 use Cwd ();
7 use Config;
8 use Text::ParseWords;
9 use IO::File;
10 use Data::Dumper;$Data::Dumper::Indent=1;
11 use IPC::Cmd qw(can_run);
12 use File::Temp qw(tempfile);
13
14 use vars qw($VERSION);
15 $VERSION = '0.280209';
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 );
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   }
42   $self->{config}{cc} = $ENV{CC} if defined $ENV{CC};
43   $self->{config}{ccflags} = join(" ", $self->{config}{ccflags}, $ENV{CFLAGS})
44      if defined $ENV{CFLAGS};
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};
48   $self->{config}{ldflags} = join(" ", $self->{config}{ldflags}, $ENV{LDFLAGS})
49      if defined $ENV{LDFLAGS};
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};
69       my $cflags = $self->{config}{ccflags};
70       $self->{config}{cxxflags} = '-x c++';
71       $self->{config}{cxxflags} .= " $cflags" if defined $cflags;
72     }
73   }
74
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})
82     or ($perl = $^X); # XXX how about using IPC::Cmd::can_run here?
83   return $perl;
84 }
85
86 sub add_to_cleanup {
87   my $self = shift;
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   }
98 }
99
100 sub get_config {
101     return %{ $_[0]->{config} };
102 }
103
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
134 sub arg_defines {
135   my ($self, %args) = @_;
136   return map "-D$_=$args{$_}", keys %args;
137 }
138
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
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   );
157   
158   my @defines = $self->arg_defines( %{$args{defines} || {}} );
159   
160   my @extra_compiler_flags =
161     $self->split_like_shell($args{extra_compiler_flags});
162   my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
163   my @ccflags = $self->split_like_shell($args{'C++'} ? $cf->{cxxflags} : $cf->{ccflags});
164   my @optimize = $self->split_like_shell($cf->{optimize});
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});
176   
177   $self->do_system(@cc, @flags, $args{source})
178     or die "error building $object_file from '$args{source}'";
179
180   return $object_file;
181 }
182
183 sub have_compiler {
184   my ($self, $is_cplusplus) = @_;
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};
188
189   my $result;
190   my $attempts = 3;
191   # tmpdir has issues for some people so fall back to current dir
192
193   # don't clobber existing files (rare, but possible)
194   my ( $FH, $tmpfile ) = tempfile( "compilet-XXXXX", SUFFIX => $suffix );
195   binmode $FH;
196
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   }
203   close $FH;
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;
216   }
217
218   return $self->{$have_compiler_flag} = $result;
219 }
220
221 sub have_cplusplus {
222   push @_, 1;
223   goto &have_compiler;
224 }
225
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
243 sub extra_link_args_after_prelink { return }
244
245 sub prelink {
246   my ($self, %args) = @_;
247
248   my ($dl_file_out, $mksymlists_args) = _prepare_mksymlists_args(\%args);
249
250   require ExtUtils::Mksymlists;
251   # dl. abbrev for dynamic library
252   ExtUtils::Mksymlists::Mksymlists( %{ $mksymlists_args } );
253
254   # Mksymlists will create one of these files
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);
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 }
284
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 =
296     $self->prelink(%args, dl_name => $args{module_name})
297       if $args{lddl} && $self->need_prelink;
298   
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   );
305
306   my @output = $args{lddl}
307     ? $self->arg_share_object_file($out)
308     : $self->arg_exec_file($out);
309   my @shrp = $self->split_like_shell($cf->{shrpenv});
310   my @ld = $self->split_like_shell($cf->{ld});
311   
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   
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   
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
346   return unless $ENV{PERL_CORE};
347
348   my $Updir = File::Spec->updir;
349   my $dir   = File::Spec->curdir;
350
351   # Try up to 5 levels upwards
352   for (0..10) {
353     if (
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     ) {
360       return Cwd::realpath( $dir );
361     }
362
363     $dir = File::Spec->catdir($dir, $Updir);
364   }
365
366   warn "PERL_CORE is set but I can't find your perl source!\n";
367   return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
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
377 sub DESTROY {
378   my $self = shift;
379   local($., $@, $!, $^E, $?);
380   $self->cleanup();
381 }
382
383 1;
384
385 # vim: ts=2 sw=2 et: