[libmoox-late-perl] 05/07: use MooX::Types::MooseLike::Base for most type constraint checks

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to tag 0.003
in repository libmoox-late-perl.

commit 87dc3f2ccfc0a359457765045966c014ff61301e
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sun Dec 2 22:12:29 2012 +0000

    use MooX::Types::MooseLike::Base for most type constraint checks
---
 lib/MooX/late.pm | 45 ++++++++++++++++++++++-----------------------
 t/01basic.t      | 11 +++++++++--
 t/02inflation.t  |  1 +
 3 files changed, 32 insertions(+), 25 deletions(-)

diff --git a/lib/MooX/late.pm b/lib/MooX/late.pm
index 7e46877..8fc1ca6 100644
--- a/lib/MooX/late.pm
+++ b/lib/MooX/late.pm
@@ -178,35 +178,30 @@ sub _process_lazy_build
 		$_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
 	}
 	
+	my $warned = 0;
 	sub _get_simple_type_constraint
 	{
+		no strict 'refs';
+		
+		eval { require MooX::Types::MooseLike::Base }
+		or do {
+			carp "Use of isa => STRING requires MooX::Types::MooseLike::Base"
+				unless $warned++;
+			return sub { 1 };
+		};
+		
 		my $tc = shift;
 		return {
-			Any       => sub { 1 },
-			Item      => sub { 1 },
-			Undef     => sub { !defined $_[0] },
-			Defined   => sub {  defined $_[0] },
-			Value     => sub { !ref $_[0] },
-			Bool      => sub {
-				return 1 unless defined $_[0];
-				!ref($_[0]) and $_[0]=~ /^(0|1|)$/;
-			},
-			Str       => sub { ref(\$_[0]) eq 'SCALAR' },
-			Num       => sub { Scalar::Util::looks_like_number($_[0]) },
-			Int       => sub { "$_[0]" =~ /^-?[0-9]+$/x },
-			ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
-			ArrayRef  => sub { ref($_[0]) eq 'ARRAY' },
-			HashRef   => sub { ref($_[0]) eq 'HASH' },
-			CodeRef   => sub { ref($_[0]) eq 'CODE' },
-			RegexpRef => sub { ref($_[0]) eq 'Regexp' },
-			GlobRef   => sub { ref($_[0]) eq 'GLOB' },
-			FileHandle=> sub {
-				Scalar::Util::openhandle($_[0]) or
-				blessed($_[0]) && $_[0]->isa('IO::Handle');
-			},
-			Object    => sub { blessed($_[0]) },
 			ClassName => sub { is_module_name($_[0]) },
 			RoleName  => sub { is_module_name($_[0]) },
+			map {
+				$_ => \&{"MooX::Types::MooseLike::Base::is_$_"};
+			}
+			qw {
+				Any Item Undef Defined Value Bool Str Num Int
+				CodeRef RegexpRef GlobRef FileHandle Object
+				ArrayRef HashRef ScalarRef
+			}
 		}->{$tc} or sub { 1 };
 	}
 
@@ -360,6 +355,10 @@ Allows C<< isa => $string >> to work when defining attributes for all
 Moose's built-in type constraints (and assumes other strings are package
 names).
 
+This feature require L<MooX::Types::MooseLike::Base>. If you don't
+have it, you'll get a warning message and all your C<isa> checks will be
+no-ops.
+
 =item 2.
 
 Allows C<< default => $non_reference_value >> to work when defining
diff --git a/t/01basic.t b/t/01basic.t
index 04cca88..24ae742 100644
--- a/t/01basic.t
+++ b/t/01basic.t
@@ -25,8 +25,15 @@ my $o2 = Local::Class->new(foo => 'bar', bar => 'foo');
 is($o2->foo, 'bar');
 is($o2->bar, 'foo');
 
-ok !eval { Local::Class->new(foo => []) };
-ok !eval { Local::Class->new(bar => []) };
+ok not eval {
+	require MooX::Types::MooseLike::Base;
+	Local::Class->new(foo => []);
+};
+
+ok not eval {
+	require MooX::Types::MooseLike::Base;
+	Local::Class->new(bar => []);
+};
 
 {
 	package Local::Other;
diff --git a/t/02inflation.t b/t/02inflation.t
index 7dcee9e..2d88d6c 100644
--- a/t/02inflation.t
+++ b/t/02inflation.t
@@ -10,6 +10,7 @@ BEGIN {
 };
 
 ok not eval {
+	require MooX::Types::MooseLike::Base;
 	my $obj = Local::Class->new(foo => [])
 };
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoox-late-perl.git