<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package ExtUtils::CBuilder::Base;
use strict;
use warnings;
use File::Spec;
use File::Basename;
use Cwd ();
use Config;
use Text::ParseWords;
use IPC::Cmd qw(can_run);
use File::Temp qw(tempfile);

our $VERSION = '0.280231'; # VERSION

# More details about C/C++ compilers:
# http://developers.sun.com/sunstudio/documentation/product/compiler.jsp
# http://gcc.gnu.org/
# http://publib.boulder.ibm.com/infocenter/comphelp/v101v121/index.jsp
# http://msdn.microsoft.com/en-us/vstudio/default.aspx

my %cc2cxx = (
    # first line order is important to support wrappers like in pkgsrc
    cc =&gt; [ 'c++', 'CC', 'aCC', 'cxx', ], # Sun Studio, HP ANSI C/C++ Compilers
    gcc =&gt; [ 'g++' ], # GNU Compiler Collection
    xlc =&gt; [ 'xlC' ], # IBM C/C++ Set, xlc without thread-safety
    xlc_r =&gt; [ 'xlC_r' ], # IBM C/C++ Set, xlc with thread-safety
    cl    =&gt; [ 'cl' ], # Microsoft Visual Studio
);

sub new {
  my $class = shift;
  my $self = bless {@_}, $class;

  $self-&gt;{properties}{perl} = $class-&gt;find_perl_interpreter
    or warn "Warning: Can't locate your perl binary";

  while (my ($k,$v) = each %Config) {
    $self-&gt;{config}{$k} = $v unless exists $self-&gt;{config}{$k};
  }
  $self-&gt;{config}{cc} = $ENV{CC} if defined $ENV{CC};
  $self-&gt;{config}{ccflags} = join(" ", $self-&gt;{config}{ccflags}, $ENV{CFLAGS})
     if defined $ENV{CFLAGS};
  $self-&gt;{config}{cxx} = $ENV{CXX} if defined $ENV{CXX};
  $self-&gt;{config}{cxxflags} = $ENV{CXXFLAGS} if defined $ENV{CXXFLAGS};
  $self-&gt;{config}{ld} = $ENV{LD} if defined $ENV{LD};
  $self-&gt;{config}{ldflags} = join(" ", $self-&gt;{config}{ldflags}, $ENV{LDFLAGS})
     if defined $ENV{LDFLAGS};

  unless ( exists $self-&gt;{config}{cxx} ) {

    my ($ccbase, $ccpath, $ccsfx ) = fileparse($self-&gt;{config}{cc}, qr/\.[^.]*/);

    ## If the path is just "cc", fileparse returns $ccpath as "./"
    $ccpath = "" if $self-&gt;{config}{cc} =~ /^\Q$ccbase$ccsfx\E$/;
      
    foreach my $cxx (@{$cc2cxx{$ccbase}}) {
      my $cxx1 = File::Spec-&gt;catfile( $ccpath, $cxx . $ccsfx);

      if( can_run( $cxx1 ) ) {
        $self-&gt;{config}{cxx} = $cxx1;
	last;
      }
      my $cxx2 = $cxx . $ccsfx;

      if( can_run( $cxx2 ) ) {
        $self-&gt;{config}{cxx} = $cxx2;
	last;
      }

      if( can_run( $cxx ) ) {
        $self-&gt;{config}{cxx} = $cxx;
	last;
      }
    }
    unless ( exists $self-&gt;{config}{cxx} ) {
      $self-&gt;{config}{cxx} = $self-&gt;{config}{cc};
      my $cflags = $self-&gt;{config}{ccflags};
      $self-&gt;{config}{cxxflags} = '-x c++';
      $self-&gt;{config}{cxxflags} .= " $cflags" if defined $cflags;
    }
  }

  return $self;
}

sub find_perl_interpreter {
  my $perl;
  File::Spec-&gt;file_name_is_absolute($perl = $^X)
    or -f ($perl = $Config::Config{perlpath})
    or ($perl = $^X); # XXX how about using IPC::Cmd::can_run here?
  return $perl;
}

sub add_to_cleanup {
  my $self = shift;
  foreach (@_) {
    $self-&gt;{files_to_clean}{$_} = 1;
  }
}

sub cleanup {
  my $self = shift;
  foreach my $file (keys %{$self-&gt;{files_to_clean}}) {
    unlink $file;
  }
}

sub get_config {
    return %{ $_[0]-&gt;{config} };
}

sub object_file {
  my ($self, $filename) = @_;

  # File name, minus the suffix
  (my $file_base = $filename) =~ s/\.[^.]+$//;
  return "$file_base$self-&gt;{config}{obj_ext}";
}

sub arg_include_dirs {
  my $self = shift;
  return map {"-I$_"} @_;
}

sub arg_nolink { '-c' }

sub arg_object_file {
  my ($self, $file) = @_;
  return ('-o', $file);
}

sub arg_share_object_file {
  my ($self, $file) = @_;
  return ($self-&gt;split_like_shell($self-&gt;{config}{lddlflags}), '-o', $file);
}

sub arg_exec_file {
  my ($self, $file) = @_;
  return ('-o', $file);
}

sub arg_defines {
  my ($self, %args) = @_;
  return map "-D$_=$args{$_}", sort keys %args;
}

sub compile {
  my ($self, %args) = @_;
  die "Missing 'source' argument to compile()" unless defined $args{source};

  my $cf = $self-&gt;{config}; # For convenience

  my $object_file = $args{object_file}
    ? $args{object_file}
    : $self-&gt;object_file($args{source});

  my $include_dirs_ref =
    (exists($args{include_dirs}) &amp;&amp; ref($args{include_dirs}) ne "ARRAY")
      ? [ $args{include_dirs} ]
      : $args{include_dirs};
  my @include_dirs = $self-&gt;arg_include_dirs(
    @{ $include_dirs_ref || [] },
    $self-&gt;perl_inc(),
  );

  my @defines = $self-&gt;arg_defines( %{$args{defines} || {}} );

  my @extra_compiler_flags =
    $self-&gt;split_like_shell($args{extra_compiler_flags});
  my @cccdlflags = $self-&gt;split_like_shell($cf-&gt;{cccdlflags});
  my @ccflags = $self-&gt;split_like_shell($args{'C++'} ? $cf-&gt;{cxxflags} : $cf-&gt;{ccflags});
  my @optimize = $self-&gt;split_like_shell($cf-&gt;{optimize});
  my @flags = (
    @include_dirs,
    @defines,
    @cccdlflags,
    @extra_compiler_flags,
    $self-&gt;arg_nolink,
    @ccflags,
    @optimize,
    $self-&gt;arg_object_file($object_file),
  );
  my @cc = $self-&gt;split_like_shell($args{'C++'} ? $cf-&gt;{cxx} : $cf-&gt;{cc});

  $self-&gt;do_system(@cc, @flags, $args{source})
    or die "error building $object_file from '$args{source}'";

  return $object_file;
}

sub have_compiler {
  my ($self, $is_cplusplus) = @_;
  my $have_compiler_flag = $is_cplusplus ? "have_cxx" : "have_cc";
  my $suffix = $is_cplusplus ? ".cc" : ".c";
  return $self-&gt;{$have_compiler_flag} if defined $self-&gt;{$have_compiler_flag};

  my $result;
  my $attempts = 3;
  # tmpdir has issues for some people so fall back to current dir

  # don't clobber existing files (rare, but possible)
  my ( $FH, $tmpfile ) = tempfile( "compilet-XXXXX", SUFFIX =&gt; $suffix );
  binmode $FH;

  if ( $is_cplusplus ) {
    print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n";
  }
  else {
    print $FH "int boot_compilet() { return 1; }\n";
  }
  close $FH;

  my ($obj_file, @lib_files);
  eval {
    local $^W = 0;
    local $self-&gt;{quiet} = 1;
    $obj_file = $self-&gt;compile('C++' =&gt; $is_cplusplus, source =&gt; $tmpfile);
    @lib_files = $self-&gt;link(objects =&gt; $obj_file, module_name =&gt; 'compilet');
  };
  $result = $@ ? 0 : 1;

  foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
    1 while unlink;
  }

  return $self-&gt;{$have_compiler_flag} = $result;
}

sub have_cplusplus {
  push @_, 1;
  goto &amp;have_compiler;
}

sub lib_file {
  my ($self, $dl_file, %args) = @_;
  $dl_file =~ s/\.[^.]+$//;
  $dl_file =~ tr/"//d;

  if (defined $args{module_name} and length $args{module_name}) {
    # Need to create with the same name as DynaLoader will load with.
    require DynaLoader;
    if (defined &amp;DynaLoader::mod2fname) {
      my $lib = DynaLoader::mod2fname([split /::/, $args{module_name}]);
      my ($dev, $lib_dir, undef) = File::Spec-&gt;splitpath($dl_file);
      $dl_file = File::Spec-&gt;catpath($dev, $lib_dir, $lib);
    }
  }

  $dl_file .= ".$self-&gt;{config}{dlext}";

  return $dl_file;
}


sub exe_file {
  my ($self, $dl_file) = @_;
  $dl_file =~ s/\.[^.]+$//;
  $dl_file =~ tr/"//d;
  return "$dl_file$self-&gt;{config}{_exe}";
}

sub need_prelink { 0 }

sub extra_link_args_after_prelink { return }

sub prelink {
  my ($self, %args) = @_;

  my ($dl_file_out, $mksymlists_args) = _prepare_mksymlists_args(\%args);

  require ExtUtils::Mksymlists;
  # dl. abbrev for dynamic library
  ExtUtils::Mksymlists::Mksymlists( %{ $mksymlists_args } );

  # Mksymlists will create one of these files
  return grep -e, map "$dl_file_out.$_", qw(ext def opt);
}

sub _prepare_mksymlists_args {
  my $args = shift;
  ($args-&gt;{dl_file} = $args-&gt;{dl_name}) =~ s/.*::// unless $args-&gt;{dl_file};

  my %mksymlists_args = (
    DL_VARS  =&gt; $args-&gt;{dl_vars}      || [],
    DL_FUNCS =&gt; $args-&gt;{dl_funcs}     || {},
    FUNCLIST =&gt; $args-&gt;{dl_func_list} || [],
    IMPORTS  =&gt; $args-&gt;{dl_imports}   || {},
    NAME     =&gt; $args-&gt;{dl_name},    # Name of the Perl module
    DLBASE   =&gt; $args-&gt;{dl_base},    # Basename of DLL file
    FILE     =&gt; $args-&gt;{dl_file},    # Dir + Basename of symlist file
    VERSION  =&gt; (defined $args-&gt;{dl_version} ? $args-&gt;{dl_version} : '0.0'),
  );
  return ($args-&gt;{dl_file}, \%mksymlists_args);
}

sub link {
  my ($self, %args) = @_;
  return $self-&gt;_do_link('lib_file', lddl =&gt; 1, %args);
}

sub link_executable {
  my ($self, %args) = @_;
  return $self-&gt;_do_link('exe_file', lddl =&gt; 0, %args);
}

sub _do_link {
  my ($self, $type, %args) = @_;

  my $cf = $self-&gt;{config}; # For convenience

  my $objects = delete $args{objects};
  $objects = [$objects] unless ref $objects;
  my $out = $args{$type} || $self-&gt;$type($objects-&gt;[0], %args);

  my @temp_files;
  @temp_files =
    $self-&gt;prelink(%args, dl_name =&gt; $args{module_name})
      if $args{lddl} &amp;&amp; $self-&gt;need_prelink;

  my @linker_flags = (
    $self-&gt;split_like_shell($args{extra_linker_flags}),
    $self-&gt;extra_link_args_after_prelink(
       %args, dl_name =&gt; $args{module_name}, prelink_res =&gt; \@temp_files
    )
  );

  my @output = $args{lddl}
    ? $self-&gt;arg_share_object_file($out)
    : $self-&gt;arg_exec_file($out);
  my @shrp = $self-&gt;split_like_shell($cf-&gt;{shrpenv});
  my @ld = $self-&gt;split_like_shell($cf-&gt;{ld});

  $self-&gt;do_system(@shrp, @ld, @output, @$objects, @linker_flags)
    or die "error building $out from @$objects";

  return wantarray ? ($out, @temp_files) : $out;
}


sub do_system {
  my ($self, @cmd) = @_;
  print "@cmd\n" if !$self-&gt;{quiet};
  return !system(@cmd);
}

sub split_like_shell {
  my ($self, $string) = @_;

  return () unless defined($string);
  return @$string if UNIVERSAL::isa($string, 'ARRAY');
  $string =~ s/^\s+|\s+$//g;
  return () unless length($string);

  # Text::ParseWords replaces all 'escaped' characters with themselves, which completely
  # breaks paths under windows. As such, we forcibly replace backwards slashes with forward
  # slashes on windows.
  $string =~ s@\\@/@g if $^O eq 'MSWin32';

  return Text::ParseWords::shellwords($string);
}

# if building perl, perl's main source directory
sub perl_src {
  # N.B. makemaker actually searches regardless of PERL_CORE, but
  # only squawks at not finding it if PERL_CORE is set

  return unless $ENV{PERL_CORE};

  my $Updir = File::Spec-&gt;updir;
  my $dir   = File::Spec-&gt;curdir;

  # Try up to 5 levels upwards
  for (0..10) {
    if (
      -f File::Spec-&gt;catfile($dir,"config_h.SH")
      &amp;&amp;
      -f File::Spec-&gt;catfile($dir,"perl.h")
      &amp;&amp;
      -f File::Spec-&gt;catfile($dir,"lib","Exporter.pm")
    ) {
      return Cwd::realpath( $dir );
    }

    $dir = File::Spec-&gt;catdir($dir, $Updir);
  }

  warn "PERL_CORE is set but I can't find your perl source!\n";
  return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
}

# directory of perl's include files
sub perl_inc {
  my $self = shift;

  $self-&gt;perl_src() || File::Spec-&gt;catdir($self-&gt;{config}{archlibexp},"CORE");
}

sub DESTROY {
  my $self = shift;
  local($., $@, $!, $^E, $?);
  $self-&gt;cleanup();
}

1;

# vim: ts=2 sw=2 et:
</pre></body></html>