lib/ExtUtils/CBuilder/Base.pm

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