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