File Coverage

blib/lib/PerlX/Perform.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	15	16	93.7
condition	16	23	69.5
subroutine	10	10	100.0
pod	3	3	100.0
total	94	103	91.2

package PerlX::Perform;

use 5.006;
use strict;

our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA);
BEGIN {
	$PerlX::Perform::AUTHORITY = 'cpan:TOBYINK';
	$PerlX::Perform::VERSION   = '0.005';

	require Exporter;
	@ISA       = qw/Exporter/;
	@EXPORT    = qw/perform wherever/;
	@EXPORT_OK = qw/perform wherever whenever/;
	%EXPORT_TAGS = (
		default   => \@EXPORT,
		all       => \@EXPORT_OK,
		wherever  => [qw/perform wherever/],
		whenever  => [qw/perform whenever/],
		);
}

sub blessed ($)
{
	my $thing = shift;
	if (ref $thing and UNIVERSAL::can($thing, 'can'))
	{
		return (ref($thing) || $thing || 1);
	}
	return;
}

sub perform (&;$)
{
	my ($coderef, $thing) = @_;
	if (defined $thing)
	{
		$_ = $thing;
		@_ = ();
		goto $coderef;
	}
	if (@_ == 1)
	{
		return PerlX::Perform::Manifesto->new($coderef);
	}
	return;
}

sub wherever ($;@)
{
	my $thing = shift;
	if (@_ and !ref $_[0] and $_[0] eq 'perform')
	{
		shift;
	}
	if (@_ and blessed $_[0] and $_[0]->isa('PerlX::Perform::Manifesto'))
	{
		my $manifesto = shift;
		@_ = ($thing);
		goto $manifesto;
	}
	elsif (@_ and ref $_[0] eq 'CODE')
	{
		my $manifesto = &perform(shift);
		@_ = ($thing);
		goto $manifesto;
	}
	return $thing;
}

*whenever = \&wherever;

package PerlX::Perform::Manifesto;

use 5.006;
use strict;

sub new
{
	my ($class, $code) = @_;

	if (PerlX::Perform::blessed $code and $code->isa(__PACKAGE__))
	{
		return $code;
	}

	bless sub {
			my $thing = shift;
			return unless defined $thing;
			$_ = $thing;
			@_ = ();
			goto $code;
		}, $class;
}

__FILE__
__END__