dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm

   1 package ExtUtils::CBuilder::Base;
   2 $ExtUtils::CBuilder::Base::VERSION = '0.280221';
   3 use strict;
   4 use File::Spec;
   5 use File::Basename;
   6 use Cwd ();
   7 use Config;
   8 use Text::ParseWords;
   9 use IPC::Cmd qw(can_run);
  10 use File::Temp qw(tempfile);
  11
  12 # More details about C/C++ compilers:
  13 # http://developers.sun.com/sunstudio/documentation/product/compiler.jsp
  14 # http://gcc.gnu.org/
  15 # http://publib.boulder.ibm.com/infocenter/comphelp/v101v121/index.jsp
  16 # http://msdn.microsoft.com/en-us/vstudio/default.aspx
  17
  18 my %cc2cxx = (
  19     # first line order is important to support wrappers like in pkgsrc
  20     cc => [ 'c++', 'CC', 'aCC', 'cxx', ], # Sun Studio, HP ANSI C/C++ Compilers
  21     gcc => [ 'g++' ], # GNU Compiler Collection
  22     xlc => [ 'xlC' ], # IBM C/C++ Set, xlc without thread-safety
  23     xlc_r => [ 'xlC_r' ], # IBM C/C++ Set, xlc with thread-safety
  24     cl    => [ 'cl' ], # Microsoft Visual Studio
  25 );
  26
  27 sub new {
  28   my $class = shift;
  29   my $self = bless {@_}, $class;
  30
  31   $self->{properties}{perl} = $class->find_perl_interpreter
  32     or warn "Warning: Can't locate your perl binary";
  33
  34   while (my ($k,$v) = each %Config) {
  35     $self->{config}{$k} = $v unless exists $self->{config}{$k};
  36   }
  37   $self->{config}{cc} = $ENV{CC} if defined $ENV{CC};
  38   $self->{config}{ccflags} = join(" ", $self->{config}{ccflags}, $ENV{CFLAGS})
  39      if defined $ENV{CFLAGS};
  40   $self->{config}{cxx} = $ENV{CXX} if defined $ENV{CXX};
  41   $self->{config}{cxxflags} = $ENV{CXXFLAGS} if defined $ENV{CXXFLAGS};
  42   $self->{config}{ld} = $ENV{LD} if defined $ENV{LD};
  43   $self->{config}{ldflags} = join(" ", $self->{config}{ldflags}, $ENV{LDFLAGS})
  44      if defined $ENV{LDFLAGS};
  45
  46   unless ( exists $self->{config}{cxx} ) {
  47     my ($ccpath, $ccbase, $ccsfx ) = fileparse($self->{config}{cc}, qr/\.[^.]*/);
  48     foreach my $cxx (@{$cc2cxx{$ccbase}}) {
  49       if( can_run( File::Spec->catfile( $ccpath, $cxx, $ccsfx ) ) ) {
  50         $self->{config}{cxx} = File::Spec->catfile( $ccpath, $cxx, $ccsfx );
  51         last;
  52       }
  53       if( can_run( File::Spec->catfile( $cxx, $ccsfx ) ) ) {
  54         $self->{config}{cxx} = File::Spec->catfile( $cxx, $ccsfx );
  55         last;
  56       }
  57       if( can_run( $cxx ) ) {
  58         $self->{config}{cxx} = $cxx;
  59         last;
  60       }
  61     }
  62     unless ( exists $self->{config}{cxx} ) {
  63       $self->{config}{cxx} = $self->{config}{cc};
  64       my $cflags = $self->{config}{ccflags};
  65       $self->{config}{cxxflags} = '-x c++';
  66       $self->{config}{cxxflags} .= " $cflags" if defined $cflags;
  67     }
  68   }
  69
  70   return $self;
  71 }
  72
  73 sub find_perl_interpreter {
  74   my $perl;
  75   File::Spec->file_name_is_absolute($perl = $^X)
  76     or -f ($perl = $Config::Config{perlpath})
  77     or ($perl = $^X); # XXX how about using IPC::Cmd::can_run here?
  78   return $perl;
  79 }
  80
  81 sub add_to_cleanup {
  82   my $self = shift;
  83   foreach (@_) {
  84     $self->{files_to_clean}{$_} = 1;
  85   }
  86 }
  87
  88 sub cleanup {
  89   my $self = shift;
  90   foreach my $file (keys %{$self->{files_to_clean}}) {
  91     unlink $file;
  92   }
  93 }
  94
  95 sub get_config {
  96     return %{ $_[0]->{config} };
  97 }
  98
  99 sub object_file {
 100   my ($self, $filename) = @_;
 101
 102   # File name, minus the suffix
 103   (my $file_base = $filename) =~ s/\.[^.]+$//;
 104   return "$file_base$self->{config}{obj_ext}";
 105 }
 106
 107 sub arg_include_dirs {
 108   my $self = shift;
 109   return map {"-I$_"} @_;
 110 }
 111
 112 sub arg_nolink { '-c' }
 113
 114 sub arg_object_file {
 115   my ($self, $file) = @_;
 116   return ('-o', $file);
 117 }
 118
 119 sub arg_share_object_file {
 120   my ($self, $file) = @_;
 121   return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file);
 122 }
 123
 124 sub arg_exec_file {
 125   my ($self, $file) = @_;
 126   return ('-o', $file);
 127 }
 128
 129 sub arg_defines {
 130   my ($self, %args) = @_;
 131   return map "-D$_=$args{$_}", keys %args;
 132 }
 133
 134 sub compile {
 135   my ($self, %args) = @_;
 136   die "Missing 'source' argument to compile()" unless defined $args{source};
 137
 138   my $cf = $self->{config}; # For convenience
 139
 140   my $object_file = $args{object_file}
 141     ? $args{object_file}
 142     : $self->object_file($args{source});
 143
 144   my $include_dirs_ref =
 145     (exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY")
 146       ? [ $args{include_dirs} ]
 147       : $args{include_dirs};
 148   my @include_dirs = $self->arg_include_dirs(
 149     @{ $include_dirs_ref || [] },
 150     $self->perl_inc(),
 151   );
 152
 153   my @defines = $self->arg_defines( %{$args{defines} || {}} );
 154
 155   my @extra_compiler_flags =
 156     $self->split_like_shell($args{extra_compiler_flags});
 157   my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
 158   my @ccflags = $self->split_like_shell($args{'C++'} ? $cf->{cxxflags} : $cf->{ccflags});
 159   my @optimize = $self->split_like_shell($cf->{optimize});
 160   my @flags = (
 161     @include_dirs,
 162     @defines,
 163     @cccdlflags,
 164     @extra_compiler_flags,
 165     $self->arg_nolink,
 166     @ccflags,
 167     @optimize,
 168     $self->arg_object_file($object_file),
 169   );
 170   my @cc = $self->split_like_shell($args{'C++'} ? $cf->{cxx} : $cf->{cc});
 171
 172   $self->do_system(@cc, @flags, $args{source})
 173     or die "error building $object_file from '$args{source}'";
 174
 175   return $object_file;
 176 }
 177
 178 sub have_compiler {
 179   my ($self, $is_cplusplus) = @_;
 180   my $have_compiler_flag = $is_cplusplus ? "have_cxx" : "have_cc";
 181   my $suffix = $is_cplusplus ? ".cc" : ".c";
 182   return $self->{$have_compiler_flag} if defined $self->{$have_compiler_flag};
 183
 184   my $result;
 185   my $attempts = 3;
 186   # tmpdir has issues for some people so fall back to current dir
 187
 188   # don't clobber existing files (rare, but possible)
 189   my ( $FH, $tmpfile ) = tempfile( "compilet-XXXXX", SUFFIX => $suffix );
 190   binmode $FH;
 191
 192   if ( $is_cplusplus ) {
 193     print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n";
 194   }
 195   else {
 196     print $FH "int boot_compilet() { return 1; }\n";
 197   }
 198   close $FH;
 199
 200   my ($obj_file, @lib_files);
 201   eval {
 202     local $^W = 0;
 203     local $self->{quiet} = 1;
 204     $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile);
 205     @lib_files = $self->link(objects => $obj_file, module_name => 'compilet');
 206   };
 207   $result = $@ ? 0 : 1;
 208
 209   foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
 210     1 while unlink;
 211   }
 212
 213   return $self->{$have_compiler_flag} = $result;
 214 }
 215
 216 sub have_cplusplus {
 217   push @_, 1;
 218   goto &have_compiler;
 219 }
 220
 221 sub lib_file {
 222   my ($self, $dl_file, %args) = @_;
 223   $dl_file =~ s/\.[^.]+$//;
 224   $dl_file =~ tr/"//d;
 225
 226   if (defined $args{module_name} and length $args{module_name}) {
 227     # Need to create with the same name as DynaLoader will load with.
 228     require DynaLoader;
 229     if (defined &DynaLoader::mod2fname) {
 230       my $lib = DynaLoader::mod2fname([split /::/, $args{module_name}]);
 231       my ($dev, $lib_dir, undef) = File::Spec->splitpath($dl_file);
 232       $dl_file = File::Spec->catpath($dev, $lib_dir, $lib);
 233     }
 234   }
 235
 236   $dl_file .= ".$self->{config}{dlext}";
 237
 238   return $dl_file;
 239 }
 240
 241
 242 sub exe_file {
 243   my ($self, $dl_file) = @_;
 244   $dl_file =~ s/\.[^.]+$//;
 245   $dl_file =~ tr/"//d;
 246   return "$dl_file$self->{config}{_exe}";
 247 }
 248
 249 sub need_prelink { 0 }
 250
 251 sub extra_link_args_after_prelink { return }
 252
 253 sub prelink {
 254   my ($self, %args) = @_;
 255
 256   my ($dl_file_out, $mksymlists_args) = _prepare_mksymlists_args(\%args);
 257
 258   require ExtUtils::Mksymlists;
 259   # dl. abbrev for dynamic library
 260   ExtUtils::Mksymlists::Mksymlists( %{ $mksymlists_args } );
 261
 262   # Mksymlists will create one of these files
 263   return grep -e, map "$dl_file_out.$_", qw(ext def opt);
 264 }
 265
 266 sub _prepare_mksymlists_args {
 267   my $args = shift;
 268   ($args->{dl_file} = $args->{dl_name}) =~ s/.*::// unless $args->{dl_file};
 269
 270   my %mksymlists_args = (
 271     DL_VARS  => $args->{dl_vars}      || [],
 272     DL_FUNCS => $args->{dl_funcs}     || {},
 273     FUNCLIST => $args->{dl_func_list} || [],
 274     IMPORTS  => $args->{dl_imports}   || {},
 275     NAME     => $args->{dl_name},    # Name of the Perl module
 276     DLBASE   => $args->{dl_base},    # Basename of DLL file
 277     FILE     => $args->{dl_file},    # Dir + Basename of symlist file
 278     VERSION  => (defined $args->{dl_version} ? $args->{dl_version} : '0.0'),
 279   );
 280   return ($args->{dl_file}, \%mksymlists_args);
 281 }
 282
 283 sub link {
 284   my ($self, %args) = @_;
 285   return $self->_do_link('lib_file', lddl => 1, %args);
 286 }
 287
 288 sub link_executable {
 289   my ($self, %args) = @_;
 290   return $self->_do_link('exe_file', lddl => 0, %args);
 291 }
 292
 293 sub _do_link {
 294   my ($self, $type, %args) = @_;
 295
 296   my $cf = $self->{config}; # For convenience
 297
 298   my $objects = delete $args{objects};
 299   $objects = [$objects] unless ref $objects;
 300   my $out = $args{$type} || $self->$type($objects->[0], %args);
 301
 302   my @temp_files;
 303   @temp_files =
 304     $self->prelink(%args, dl_name => $args{module_name})
 305       if $args{lddl} && $self->need_prelink;
 306
 307   my @linker_flags = (
 308     $self->split_like_shell($args{extra_linker_flags}),
 309     $self->extra_link_args_after_prelink(
 310        %args, dl_name => $args{module_name}, prelink_res => \@temp_files
 311     )
 312   );
 313
 314   my @output = $args{lddl}
 315     ? $self->arg_share_object_file($out)
 316     : $self->arg_exec_file($out);
 317   my @shrp = $self->split_like_shell($cf->{shrpenv});
 318   my @ld = $self->split_like_shell($cf->{ld});
 319
 320   $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags)
 321     or die "error building $out from @$objects";
 322
 323   return wantarray ? ($out, @temp_files) : $out;
 324 }
 325
 326
 327 sub do_system {
 328   my ($self, @cmd) = @_;
 329   print "@cmd\n" if !$self->{quiet};
 330   return !system(@cmd);
 331 }
 332
 333 sub split_like_shell {
 334   my ($self, $string) = @_;
 335
 336   return () unless defined($string);
 337   return @$string if UNIVERSAL::isa($string, 'ARRAY');
 338   $string =~ s/^\s+|\s+$//g;
 339   return () unless length($string);
 340
 341   # Text::ParseWords replaces all 'escaped' characters with themselves, which completely
 342   # breaks paths under windows. As such, we forcibly replace backwards slashes with forward
 343   # slashes on windows.
 344   $string =~ s@\\@/@g if $^O eq 'MSWin32';
 345
 346   return Text::ParseWords::shellwords($string);
 347 }
 348
 349 # if building perl, perl's main source directory
 350 sub perl_src {
 351   # N.B. makemaker actually searches regardless of PERL_CORE, but
 352   # only squawks at not finding it if PERL_CORE is set
 353
 354   return unless $ENV{PERL_CORE};
 355
 356   my $Updir = File::Spec->updir;
 357   my $dir   = File::Spec->curdir;
 358
 359   # Try up to 5 levels upwards
 360   for (0..10) {
 361     if (
 362       -f File::Spec->catfile($dir,"config_h.SH")
 363       &&
 364       -f File::Spec->catfile($dir,"perl.h")
 365       &&
 366       -f File::Spec->catfile($dir,"lib","Exporter.pm")
 367     ) {
 368       return Cwd::realpath( $dir );
 369     }
 370
 371     $dir = File::Spec->catdir($dir, $Updir);
 372   }
 373
 374   warn "PERL_CORE is set but I can't find your perl source!\n";
 375   return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
 376 }
 377
 378 # directory of perl's include files
 379 sub perl_inc {
 380   my $self = shift;
 381
 382   $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE");
 383 }
 384
 385 sub DESTROY {
 386   my $self = shift;
 387   local($., $@, $!, $^E, $?);
 388   $self->cleanup();
 389 }
 390
 391 1;
 392
 393 # vim: ts=2 sw=2 et: