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