This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ea3e7dedc42e6461c2b0652a0debbf830690d6b6
[perl5.git] / cpan / 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
11 use vars qw($VERSION);
12 $VERSION = '0.2703_01';
13
14 sub new {
15   my $class = shift;
16   my $self = bless {@_}, $class;
17
18   $self->{properties}{perl} = $class->find_perl_interpreter
19     or warn "Warning: Can't locate your perl binary";
20
21   while (my ($k,$v) = each %Config) {
22     $self->{config}{$k} = $v unless exists $self->{config}{$k};
23   }
24   $self->{config}{cc} = $ENV{CC} if exists $ENV{CC};
25   return $self;
26 }
27
28 sub find_perl_interpreter {
29   my $perl;
30   File::Spec->file_name_is_absolute($perl = $^X)
31     or -f ($perl = $Config::Config{perlpath})
32     or ($perl = $^X);
33   return $perl;
34 }
35
36 sub add_to_cleanup {
37   my $self = shift;
38   foreach (@_) {
39     $self->{files_to_clean}{$_} = 1;
40   }
41 }
42
43 sub cleanup {
44   my $self = shift;
45   foreach my $file (keys %{$self->{files_to_clean}}) {
46     unlink $file;
47   }
48 }
49
50 sub object_file {
51   my ($self, $filename) = @_;
52
53   # File name, minus the suffix
54   (my $file_base = $filename) =~ s/\.[^.]+$//;
55   return "$file_base$self->{config}{obj_ext}";
56 }
57
58 sub arg_include_dirs {
59   my $self = shift;
60   return map {"-I$_"} @_;
61 }
62
63 sub arg_nolink { '-c' }
64
65 sub arg_object_file {
66   my ($self, $file) = @_;
67   return ('-o', $file);
68 }
69
70 sub arg_share_object_file {
71   my ($self, $file) = @_;
72   return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file);
73 }
74
75 sub arg_exec_file {
76   my ($self, $file) = @_;
77   return ('-o', $file);
78 }
79
80 sub arg_defines {
81   my ($self, %args) = @_;
82   return map "-D$_=$args{$_}", keys %args;
83 }
84
85 sub compile {
86   my ($self, %args) = @_;
87   die "Missing 'source' argument to compile()" unless defined $args{source};
88   
89   my $cf = $self->{config}; # For convenience
90
91   $args{object_file} ||= $self->object_file($args{source});
92
93   $args{include_dirs} = [ $args{include_dirs} ]
94     if exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY";
95
96   my @include_dirs = $self->arg_include_dirs
97     (@{$args{include_dirs} || []},
98      $self->perl_inc());
99   
100   my @defines = $self->arg_defines( %{$args{defines} || {}} );
101   
102   my @extra_compiler_flags = $self->split_like_shell($args{extra_compiler_flags});
103   my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
104   my @ccflags = $self->split_like_shell($cf->{ccflags});
105   push @ccflags, qw/-x c++/ if $args{'C++'};
106   my @optimize = $self->split_like_shell($cf->{optimize});
107   my @flags = (@include_dirs, @defines, @cccdlflags, @extra_compiler_flags,
108                $self->arg_nolink,
109                @ccflags, @optimize,
110                $self->arg_object_file($args{object_file}),
111               );
112   
113   my @cc = $self->split_like_shell($cf->{cc});
114   
115   $self->do_system(@cc, @flags, $args{source})
116     or die "error building $args{object_file} from '$args{source}'";
117
118   return $args{object_file};
119 }
120
121 sub have_compiler {
122   my ($self, $is_cplusplus) = @_;
123   return $self->{have_compiler} if defined $self->{have_compiler};
124
125   my $result;
126   my $attempts = 3;
127   # tmpdir has issues for some people so fall back to current dir
128   DIR: for my $dir ( File::Spec->tmpdir, '.' ) {
129
130     # don't clobber existing files (rare, but possible)
131     my $rand = int(rand(2**31));
132     my $tmpfile = File::Spec->catfile($dir, "compilet-$rand.c");
133     $tmpfile .= "c" if $is_cplusplus;
134     if ( -e $tmpfile ) {
135       redo DIR if $attempts--;
136       next DIR;
137     }
138
139     {
140       my $FH = IO::File->new("> $tmpfile") or die "Can't create $tmpfile: $!";
141       if ( $is_cplusplus ) {
142         print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n";
143       }
144       else {
145         print $FH "int boot_compilet() { return 1; }\n";
146       }
147     }
148
149     my ($obj_file, @lib_files);
150     eval {
151       local $^W = 0;
152       local $self->{quiet} = 1;
153       $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile);
154       @lib_files = $self->link(objects => $obj_file, module_name => 'compilet');
155     };
156     $result = $@ ? 0 : 1;
157
158     foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
159       1 while unlink;
160     }
161     last DIR if $result;
162   }
163
164   return $self->{have_compiler} = $result;
165 }
166
167 sub have_cplusplus {
168   push @_, 1;
169   goto &have_compiler;
170 }
171
172 sub lib_file {
173   my ($self, $dl_file) = @_;
174   $dl_file =~ s/\.[^.]+$//;
175   $dl_file =~ tr/"//d;
176   return "$dl_file.$self->{config}{dlext}";
177 }
178
179
180 sub exe_file {
181   my ($self, $dl_file) = @_;
182   $dl_file =~ s/\.[^.]+$//;
183   $dl_file =~ tr/"//d;
184   return "$dl_file$self->{config}{_exe}";
185 }
186
187 sub need_prelink { 0 }
188
189 sub extra_link_args_after_prelink { return }
190
191 sub prelink {
192   my ($self, %args) = @_;
193   
194   ($args{dl_file} = $args{dl_name}) =~ s/.*::// unless $args{dl_file};
195   
196   require ExtUtils::Mksymlists;
197   ExtUtils::Mksymlists::Mksymlists( # dl. abbrev for dynamic library
198     DL_VARS  => $args{dl_vars}      || [],
199     DL_FUNCS => $args{dl_funcs}     || {},
200     FUNCLIST => $args{dl_func_list} || [],
201     IMPORTS  => $args{dl_imports}   || {},
202     NAME     => $args{dl_name},         # Name of the Perl module
203     DLBASE   => $args{dl_base},         # Basename of DLL file
204     FILE     => $args{dl_file},         # Dir + Basename of symlist file
205     VERSION  => (defined $args{dl_version} ? $args{dl_version} : '0.0'),
206   );
207   
208   # Mksymlists will create one of these files
209   return grep -e, map "$args{dl_file}.$_", qw(ext def opt);
210 }
211
212 sub link {
213   my ($self, %args) = @_;
214   return $self->_do_link('lib_file', lddl => 1, %args);
215 }
216
217 sub link_executable {
218   my ($self, %args) = @_;
219   return $self->_do_link('exe_file', lddl => 0, %args);
220 }
221
222 sub _do_link {
223   my ($self, $type, %args) = @_;
224
225   my $cf = $self->{config}; # For convenience
226   
227   my $objects = delete $args{objects};
228   $objects = [$objects] unless ref $objects;
229   my $out = $args{$type} || $self->$type($objects->[0]);
230   
231   my @temp_files;
232   @temp_files =
233     $self->prelink(%args,
234                    dl_name => $args{module_name}) if $args{lddl} && $self->need_prelink;
235   
236   my @linker_flags = ($self->split_like_shell($args{extra_linker_flags}),
237                       $self->extra_link_args_after_prelink(%args, dl_name => $args{module_name},
238                                                            prelink_res => \@temp_files));
239
240   my @output = $args{lddl} ? $self->arg_share_object_file($out) : $self->arg_exec_file($out);
241   my @shrp = $self->split_like_shell($cf->{shrpenv});
242   my @ld = $self->split_like_shell($cf->{ld});
243   
244   $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags)
245     or die "error building $out from @$objects";
246   
247   return wantarray ? ($out, @temp_files) : $out;
248 }
249
250
251 sub do_system {
252   my ($self, @cmd) = @_;
253   print "@cmd\n" if !$self->{quiet};
254   return !system(@cmd);
255 }
256
257 sub split_like_shell {
258   my ($self, $string) = @_;
259   
260   return () unless defined($string);
261   return @$string if UNIVERSAL::isa($string, 'ARRAY');
262   $string =~ s/^\s+|\s+$//g;
263   return () unless length($string);
264   
265   return Text::ParseWords::shellwords($string);
266 }
267
268 # if building perl, perl's main source directory
269 sub perl_src {
270   # N.B. makemaker actually searches regardless of PERL_CORE, but
271   # only squawks at not finding it if PERL_CORE is set
272
273   return unless $ENV{PERL_CORE};
274
275   my $Updir = File::Spec->updir;
276   my $dir   = File::Spec->curdir;
277
278   # Try up to 5 levels upwards
279   for (0..10) {
280     if (
281         -f File::Spec->catfile($dir,"config_h.SH")
282         &&
283         -f File::Spec->catfile($dir,"perl.h")
284         &&
285         -f File::Spec->catfile($dir,"lib","Exporter.pm")
286        ) {
287       return Cwd::realpath( $dir );
288     }
289
290     $dir = File::Spec->catdir($dir, $Updir);
291   }
292
293   warn "PERL_CORE is set but I can't find your perl source!\n";
294   return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
295 }
296
297 # directory of perl's include files
298 sub perl_inc {
299   my $self = shift;
300
301   $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE");
302 }
303
304 sub DESTROY {
305   my $self = shift;
306   local($., $@, $!, $^E, $?);
307   $self->cleanup();
308 }
309
310 1;