git.maemo.org Git - pkg-perl/blob - deb-src/libextutils-cbuilder-perl/libextutils-cbuilder-perl-0.23/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.23';
  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;