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