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