File Coverage

blib/lib/match/simple.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	29	29	100.0

package match::simple;

use 5.006001;
use strict;
use warnings;

use Exporter::Tiny;
use List::Util 1.33 qw(any);
use Scalar::Util qw(blessed);

BEGIN {
	$match::simple::AUTHORITY = 'cpan:TOBYINK';
	$match::simple::VERSION   = '0.010';
}

our @ISA       = qw( Exporter::Tiny );
our @EXPORT    = qw( M );
our @EXPORT_OK = qw( match );

my $xs;
unless (($ENV{MATCH_SIMPLE_IMPLEMENTATION}||'') =~ /pp/i)
{
	eval {
		require match::simple::XS;
		match::simple::XS->VERSION(0.001);  # minimum

		# Unless we're a development version...
		# Avoid using an unstable version of ::XS
		unless (match::simple->VERSION =~ /_/)
		{
			die if match::simple::XS->VERSION =~ /_/;
		}

		$xs = match::simple::XS->can('match');
	};
}

eval($xs ? <<'XS' : <<'PP');

sub IMPLEMENTATION () { "XS" }

*match = *match::simple::XS::match;

XS

sub IMPLEMENTATION () { "PP" }

sub match
{
	no warnings qw(uninitialized numeric);

	my ($a, $b) = @_;

	return(!defined $a)                    if !defined($b);
	return($a eq $b)                       if !ref($b);
	return($a =~ $b)                       if ref($b) eq q(Regexp);
	return do{ local $_ = $a; !!$b->($a) } if ref($b) eq q(CODE);
	return any { match($a, $_) } @$b       if ref($b) eq q(ARRAY);
	return !!$b->check($a)                 if blessed($b) && $b->isa("Type::Tiny");
	return !!$b->MATCH($a, 1)              if blessed($b) && $b->can("MATCH");
	return eval 'no warnings; !!($a~~$b)'  if blessed($b) && $] >= 5.010 && do { require overload; overload::Method($b, "~~") };

	require Carp;
	Carp::croak("match::simple cannot match anything against: $b");
}

PP

sub _generate_M
{
	require Sub::Infix;
	&Sub::Infix::infix(\&match);
}

1;

__END__