X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=a11a478522510e595a499386265033edc9c50137;hp=4f77130b4b090b189d90d4a010855c898cc5bad2;hb=6d28c5cf89bfd4c00e675e95aff6c31b61aeb805;hpb=29607c0291634fac077d6e1c75e1491ba455c010

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 4f77130..a11a478 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -5,6 +5,8 @@ use base 'Exporter';
 
 use Carp ();
 use Scalar::Util qw/blessed looks_like_number openhandle/;
+
+use Mouse::Util;
 use Mouse::Meta::TypeConstraint;
 
 our @EXPORT = qw(
@@ -18,19 +20,17 @@ my %COERCE;
 my %COERCE_KEYS;
 
 sub as ($) {
-    as => $_[0]
+    return(as => $_[0]);
 }
 sub where (&) {
-    where => $_[0]
+    return(where => $_[0])
 }
 sub message (&) {
-    message => $_[0]
+    return(message => $_[0])
 }
 
 sub from { @_ }
-sub via (&) {
-    $_[0]
-}
+sub via (&) { $_[0] }
 
 BEGIN {
     no warnings 'uninitialized';
@@ -78,9 +78,10 @@ BEGIN {
 sub type {
     my $pkg = caller(0);
     my($name, %conf) = @_;
+
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
-    };
+    }
     my $constraint = $conf{where} || do {
         my $as = delete $conf{as} || 'Any';
         if (! exists $TYPE{$as}) {
@@ -104,8 +105,20 @@ sub type {
 }
 
 sub subtype {
-    my $pkg = caller(0);
-    my($name, %conf) = @_;
+    my $pkg = caller;
+
+    my $name;
+    my %conf;
+
+    if(@_ % 2){ # odd number of arguments
+        $name = shift;
+        %conf = @_;
+    }
+    else{
+        %conf = @_;
+        $name = $conf{name} || '__ANON__';
+    }
+
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
@@ -133,7 +146,7 @@ sub subtype {
 }
 
 sub coerce {
-    my($name, %conf) = @_;
+    my $name = shift;
 
     Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
         unless $TYPE{$name};
@@ -142,7 +155,8 @@ sub coerce {
         $COERCE{$name}      = {};
         $COERCE_KEYS{$name} = [];
     }
-    while (my($type, $code) = each %conf) {
+
+    while (my($type, $code) = splice @_, 0, 2) {
         Carp::croak "A coercion action already exists for '$type'"
             if $COERCE{$name}->{$type};
 
@@ -155,9 +169,10 @@ sub coerce {
             }
         }
 
-        unshift @{ $COERCE_KEYS{$name} }, $type;
+        push @{ $COERCE_KEYS{$name} }, $type;
         $COERCE{$name}->{$type} = $code;
     }
+    return;
 }
 
 sub class_type {
@@ -308,6 +323,13 @@ sub find_type_constraint {
 sub find_or_create_isa_type_constraint {
     my $type_constraint = shift;
 
+    Carp::confess("Got isa => type_constraints, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef and Maybe (rt.cpan.org #39795)")
+        if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
+           $1 ne 'ArrayRef' &&
+           $1 ne 'HashRef'  &&
+           $1 ne 'Maybe'
+    ;
+
     my $code;
 
     $type_constraint =~ s/\s+//g;