File Coverage

blib/lib/ExtUtils/Depends.pm

Criterion	Covered	Total	%
statement	170	186	91.4
branch	30	48	62.5
condition	12	16	75.0
subroutine	32	33	96.9
pod	15	19	78.9
total	259	302	85.7

package ExtUtils::Depends;

use strict;
use warnings;
use Carp;
use Config;
use File::Find;
use File::Spec;
use Data::Dumper;

our $VERSION = '0.8002';

sub import {
	my $class = shift;
	return unless @_;
        die "$class version $_[0] is required--this is only version $VERSION"
		if $VERSION < $_[0];
}

sub new {
	my ($class, $name, @deps) = @_;
	my $self = bless {
		name => $name,
		deps => {},
		inc => [],
		libs => '',

		pm => {},
		typemaps => [],
		xs => [],
		c => [],
	}, $class;

	$self->add_deps (@deps);

	# attempt to load these now, so we'll find out as soon as possible
	# whether the dependencies are valid.  we'll load them again in
	# get_makefile_vars to catch any added between now and then.
	$self->load_deps;

	return $self;
}

sub add_deps {
	my $self = shift;
	foreach my $d (@_) {
		$self->{deps}{$d} ||= undef;
	}
}

sub get_deps {
	my $self = shift;
	$self->load_deps; # just in case

	return %{$self->{deps}};
}

sub set_inc {
	my $self = shift;
	push @{ $self->{inc} }, @_;
}

sub set_libs {
	my ($self, $newlibs) = @_;
	$self->{libs} = $newlibs;
}

sub add_pm {
	my ($self, %pm) = @_;
	while (my ($key, $value) = each %pm) {
		$self->{pm}{$key} = $value;
	}
}

sub _listkey_add_list {
	my ($self, $key, @list) = @_;
	$self->{$key} = [] unless $self->{$key};
	push @{ $self->{$key} }, @list;
}

sub add_xs       { shift->_listkey_add_list ('xs',       @_) }
sub add_c        { shift->_listkey_add_list ('c',        @_) }
sub add_typemaps {
	my $self = shift;
	$self->_listkey_add_list ('typemaps', @_);
	$self->install (@_);
}

# no-op, only used for source back-compat
sub add_headers { carp "add_headers() is a no-op" }

####### PRIVATE
sub basename { (File::Spec->splitdir ($_[0]))[-1] }
# get the name in Makefile syntax.
sub installed_filename {
	my $self = shift;
	return '$(INST_ARCHLIB)/$(FULLEXT)/Install/'.basename ($_[0]);
}

sub install {
	# install things by adding them to the hash of pm files that gets
	# passed through WriteMakefile's PM key.
	my $self = shift;
	foreach my $f (@_) {
		$self->add_pm ($f, $self->installed_filename ($f));
	}
}

sub save_config {
	use Data::Dumper;
	local $Data::Dumper::Terse = 0;
	local $Data::Dumper::Sortkeys = 1;
	use IO::File;

	my ($self, $filename) = @_;

	my $file = IO::File->new (">".$filename)
		or croak "can't open '$filename' for writing: $!\n";

	print $file "package $self->{name}\::Install::Files;\n\n";
	print $file "".Data::Dumper->Dump([{
		inc => join (" ", @{ $self->{inc} }),
		libs => $self->{libs},
		typemaps => [ map { basename $_ } @{ $self->{typemaps} } ],
		deps => [sort keys %{ $self->{deps} }],
	}], ['self']);
	print $file <<'EOF';

@deps = @{ $self->{deps} };
@typemaps = @{ $self->{typemaps} };
$libs = $self->{libs};
$inc = $self->{inc};
EOF
	# this is ridiculous, but old versions of ExtUtils::Depends take
	# first $loadedmodule::CORE and then $INC{$file} --- the fallback
	# includes the Filename.pm, which is not useful.  so we must add
	# this crappy code.  we don't worry about portable pathnames,
	# as the old code didn't either.
	(my $mdir = $self->{name}) =~ s{::}{/}g;
	print $file <<"EOT";

	\$CORE = undef;
	foreach (\@INC) {
		if ( -f \$_ . "/$mdir/Install/Files.pm") {
			\$CORE = \$_ . "/$mdir/Install/";
			last;
		}
	}

	sub deps { \@{ \$self->{deps} }; }

	sub Inline {
		my (\$class, \$lang) = \@_;
		+{ map { (uc(\$_) => \$self->{\$_}) } qw(inc libs typemaps) };
	}
EOT

	print $file "\n1;\n";

	close $file;

	# we need to ensure that the file we just created gets put into
	# the install dir with everything else.
	#$self->install ($filename);
	$self->add_pm ($filename, $self->installed_filename ('Files.pm'));
}

sub load {
	my $dep = shift;
	my @pieces = split /::/, $dep;
	my @suffix = qw/ Install Files /;
	# not File::Spec - see perldoc -f require
	my $relpath = join('/', @pieces, @suffix) . '.pm';
	my $depinstallfiles = join "::", @pieces, @suffix;
	eval {
		require $relpath
	} or die " *** Can't load dependency information for $dep:\n   $@\n";
	#print Dumper(\%INC);

	# effectively $instpath = dirname($INC{$relpath})
	my ($vol,$dirs,$file) = File::Spec->splitpath($INC{$relpath});
	my $instpath = File::Spec->catpath($vol,$dirs,'');

	no strict;

	croak "No dependency information found for $dep"
		unless $instpath;

	if (not File::Spec->file_name_is_absolute ($instpath)) {
		$instpath = File::Spec->rel2abs ($instpath);
	}

	# this will not exist when loading files from old versions
	# of ExtUtils::Depends.
	my @deps = eval { $depinstallfiles->deps };
	@deps = @{"$depinstallfiles\::deps"}
		if $@ and exists ${"$depinstallfiles\::"}{deps};

	my (@typemaps, $inc, $libs);
	my $inline = eval { $depinstallfiles->Inline('C') };
	if (!$@) {
		$inc = $inline->{INC} || '';
		$libs = $inline->{LIBS} || '';
		@typemaps = @{ $inline->{TYPEMAPS} || [] };
	} else {
		$inc = ${"$depinstallfiles\::inc"} || '';
		$libs = ${"$depinstallfiles\::libs"} || '';
		@typemaps = @{"$depinstallfiles\::typemaps"};
	}
	@typemaps = map { File::Spec->rel2abs ($_, $instpath) } @typemaps;

	{
		instpath => $instpath,
		typemaps => \@typemaps,
		inc      => "-I". _quote_if_space($instpath) ." $inc",
		libs     => $libs,
		deps     => \@deps,
	}
}

sub _quote_if_space { $_[0] =~ / / ? qq{"$_[0]"} : $_[0] }

sub load_deps {
	my $self = shift;
	my @load = grep !$self->{deps}{$_}, keys %{ $self->{deps} };
	my %in_load; @in_load{@load} = ();
	while (@load) {
		my $d = shift @load;
		$self->{deps}{$d} = my $dep = load($d);
		my @new_deps = grep !($self->{deps}{$_} || exists $in_load{$_}),
			@{ $dep->{deps} || [] };
		push @load, @new_deps;
		@in_load{@new_deps} = ();
	}
}

sub uniquify {
	my %seen;
	grep !$seen{$_}++, @_;
}

sub get_makefile_vars {
	my $self = shift;

	# collect and uniquify things from the dependencies.
	# first, ensure they are completely loaded.
	$self->load_deps;

	my @incbits = @{ $self->{inc} };
	my @libsbits = $self->{libs};
	my @typemaps = @{ $self->{typemaps} };
	foreach my $d (sort keys %{ $self->{deps} }) {
		my $dep = $self->{deps}{$d};
		push @incbits, @{ $dep->{defines} } if $dep->{defines};
		push @incbits, $dep->{inc} if $dep->{inc};
		push @libsbits, $dep->{libs} if $dep->{libs};
		push @typemaps, @{ $dep->{typemaps} } if $dep->{typemaps};
	}

	# we have a fair bit of work to do for the xs files...
	my @clean = ();
	my @OBJECT = ();
	my %XS = ();
	foreach my $xs (@{ $self->{xs} }) {
		(my $c = $xs) =~ s/\.xs$/\.c/i;
		(my $o = $xs) =~ s/\.xs$/\$(OBJ_EXT)/i;
		$XS{$xs} = $c;
		push @OBJECT, $o;
		# according to the MakeMaker manpage, the C files listed in
		# XS will be added automatically to the list of cleanfiles.
		push @clean, $o;
	}

	# we may have C files, as well:
	foreach my $c (@{ $self->{c} }) {
		(my $o = $c) =~ s/\.c$/\$(OBJ_EXT)/i;
		push @OBJECT, $o;
		push @clean, $o;
	}

	my %vars = (
		INC => join (' ', uniquify @incbits),
		LIBS => join (' ', uniquify @libsbits),
		LDFROM => join (' ', '$(OBJECT)', map _quote_if_space($_), find_extra_libs($self->{deps}, \@INC)),
		TYPEMAPS => \@typemaps,
	);

	# we don't want to provide these if there is no data in them;
	# that way, the caller can still get default behavior out of
	# MakeMaker when INC, LIBS and TYPEMAPS are all that are required.
	$vars{PM} = $self->{pm}
		if %{ $self->{pm} };
	$vars{clean} = { FILES => join (" ", @clean), }
		if @clean;
	$vars{OBJECT} = join (" ", @OBJECT)
		if @OBJECT;
	$vars{XS} = \%XS
		if %XS;

	%vars;
}

# Search for extra library files to link against on Windows (either native
# Windows library # files, or Cygwin library files)
# NOTE: not meant to be called publicly, so no POD documentation
# see https://rt.cpan.org/Ticket/Display.html?id=45224 for discussion
my %exts; BEGIN { %exts = (
  MSWin32 => [ ".lib", ".$Config{dlext}", $Config{_a} ],
  cygwin => [ '.dll' ],
  android => [ ".$Config{dlext}" ],
); }
sub find_extra_libs {
  my ($deps, $search) = @_;
  return () if !keys %$deps;
  return () unless my $exts = $exts{$^O};
  require File::Spec::Functions;
  my @found_libs = ();
  DEP: foreach my $name (keys %$deps) {
    my @parts = ('auto', split /::/, $name);
    my $stem = defined &DynaLoader::mod2fname
      ? DynaLoader::mod2fname(\@parts) : $parts[-1];
    my @bases = map $stem.$_, @$exts;
    for my $dir (grep -d, @$search) { # only extant dirs
      my ($found) = grep -f, map File::Spec::Functions::catfile($dir, @parts, $_), @bases;
      next if !defined $found;
      push @found_libs, $found;
      next DEP;
    }
  }
  @found_libs;
}

1;

__END__