File Coverage

blib/lib/ExtUtils/Builder/Action/Function.pm

Criterion	Covered	Total	%
statement	52	58	89.6
branch	10	14	71.4
condition	6	13	46.1
subroutine	11	14	78.5
pod	7	8	87.5
total	86	107	80.3

package ExtUtils::Builder::Action::Function;
$ExtUtils::Builder::Action::Function::VERSION = '0.020';
use strict;
use warnings;

use Carp 'croak';
use ExtUtils::Builder::Util 'get_perl';

use parent 'ExtUtils::Builder::Action::Perl';

sub new {
	my ($class, %args) = @_;
	croak 'Attribute module is not defined' if not defined $args{module};
	croak 'Attribute function is not defined' if not defined $args{function};
	$args{fullname} = join '::', $args{module}, $args{function};
	$args{exports} ||= !!0;
	$args{arguments} //= [];
	my $self = $class->SUPER::new(%args);
	return $self;
}

sub modules {
	my ($self) = @_;
	return $self->{module};
}

sub module {
	my ($self) = @_;
	return $self->{module};
}

sub function {
	my ($self) = @_;
	return $self->{function};
}

sub arguments {
	my ($self) = @_;
	return @{ $self->{arguments} };
}

sub execute {
	my ($self, %args) = @_;
	my $module = $self->{module};
	(my $filename = $module) =~ s{::}{/}g;
	require "$filename.pm";

	if (!$args{quiet}) {
		my $message = $self->{message} // sprintf "%s(%s)", $self->{fullname}, join ", ", $self->arguments;
		print "$message\n";
	}

	my $code = do { no strict 'refs'; \&{ $self->{fullname} } };
	$code->($self->arguments);
}

sub to_code {
	my ($self, %args) = @_;
	my $shortcut = $args{skip_loading} && $args{skip_loading} eq 'main' && $self->{exports};
	my $name = $shortcut ? $self->{function} : $self->{fullname};
	my @modules = $args{skip_loading} ? () : "require $self->{module}";
	my $arguments = $self->arguments ? do {
		require Data::Dumper; (Data::Dumper->new([ [ $self->arguments ] ])->Terse(1)->Indent(0)->Dump =~ /^ \[ (.*) \] $/x)[0]
	} : '';
	return join '; ', @modules, sprintf '%s(%s)', $name, $arguments;
}

sub to_command {
	my ($self, %opts) = @_;
	my $module = $self->{exports} eq 'explicit' ? "-M$self->{module}=$self->{function}" : "-M$self->{module}";
	my $perl = $opts{perl} // get_perl(%opts);
	return [ $perl, $module, '-e', $self->to_code(skip_loading => 'main') ];
}

1;

#ABSTRACT: Actions for perl function calls

__END__