much faster impl. for constructor/accessor. this is a same behavior with Moose.

[gitmo/Mouse.git] / lib / Mouse / Util / TypeConstraints.pm

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 885788a..d81d5d0 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -38,31 +38,31 @@ my $optimized_constraints_base;
         Any        => sub { 1 },
         Item       => sub { 1 },
         Bool       => sub {
-            !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0'
+            !defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'
         },
-        Undef      => sub { !defined($_) },
-        Defined    => sub { defined($_) },
-        Value      => sub { defined($_) && !ref($_) },
-        Num        => sub { !ref($_) && looks_like_number($_) },
-        Int        => sub { defined($_) && !ref($_) && /^-?[0-9]+$/ },
-        Str        => sub { defined($_) && !ref($_) },
-        ClassName  => sub { Mouse::is_class_loaded($_) },
-        Ref        => sub { ref($_) },
-
-        ScalarRef  => sub { ref($_) eq 'SCALAR' },
-        ArrayRef   => sub { ref($_) eq 'ARRAY'  },
-        HashRef    => sub { ref($_) eq 'HASH'   },
-        CodeRef    => sub { ref($_) eq 'CODE'   },
-        RegexpRef  => sub { ref($_) eq 'Regexp' },
-        GlobRef    => sub { ref($_) eq 'GLOB'   },
+        Undef      => sub { !defined($_[0]) },
+        Defined    => sub { defined($_[0]) },
+        Value      => sub { defined($_[0]) && !ref($_[0]) },
+        Num        => sub { !ref($_[0]) && looks_like_number($_[0]) },
+        Int        => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
+        Str        => sub { defined($_[0]) && !ref($_[0]) },
+        ClassName  => sub { Mouse::is_class_loaded($_[0]) },
+        Ref        => sub { ref($_[0]) },
+
+        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 {
-            ref($_) eq 'GLOB' && openhandle($_)
+            ref($_[0]) eq 'GLOB' && openhandle($_[0])
             or
-            blessed($_) && $_->isa("IO::Handle")
+            blessed($_[0]) && $_[0]->isa("IO::Handle")
         },
 
-        Object     => sub { blessed($_) && blessed($_) ne 'Regexp' },
+        Object     => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
     );
 
     sub optimized_constraints { \%TYPE }
@@ -81,7 +81,7 @@ sub type {
     my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
 
     $TYPE_SOURCE{$name} = $pkg;
-    $TYPE{$name} = $constraint;
+    $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
 }
 
 sub subtype {
@@ -90,15 +90,21 @@ sub subtype {
     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 { $TYPE{delete $conf{as} || 'Any' } };
+    my $constraint = $conf{where} || do {
+        my $as = delete $conf{as} || 'Any';
+        if (! exists $TYPE{$as}) { # Perhaps it's a parameterized source?
+            Mouse::Meta::Attribute::_build_type_constraint($as);
+        }
+        $TYPE{$as};
+    };
     my $as         = $conf{as} || '';
 
     $TYPE_SOURCE{$name} = $pkg;
 
     if ($as = $TYPE{$as}) {
-        $TYPE{$name} = sub { $as->($_) && $constraint->($_) };
+        $TYPE{$name} = sub { local $_=$_[0]; $as->($_) && $constraint->($_) };
     } else {
-        $TYPE{$name} = $constraint;
+        $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
     }
 }
 
@@ -116,8 +122,14 @@ sub coerce {
         Carp::croak "A coercion action already exists for '$type'"
             if $COERCE{$name}->{$type};
 
-        Carp::croak "Could not find the type constraint ($type) to coerce from"
-            unless $TYPE{$type};
+        if (! $TYPE{$type}) {
+            # looks parameterized
+            if ($type =~ /^[^\[]+\[.+\]$/) {
+                Mouse::Meta::Attribute::_build_type_constraint($type);
+            } else {
+                Carp::croak "Could not find the type constraint ($type) to coerce from"
+            }
+        }
 
         push @{ $COERCE_KEYS{$name} }, $type;
         $COERCE{$name}->{$type} = $code;
@@ -152,16 +164,28 @@ sub typecast_constraints {
         next unless $COERCE{$type};
         for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
             $_ = $value;
-            next unless $TYPE{$coerce_type}->();
+            next unless $TYPE{$coerce_type}->($value);
             $_ = $value;
-            $_ = $COERCE{$type}->{$coerce_type}->();
-            return $_ if $type_constraint->();
+            $_ = $COERCE{$type}->{$coerce_type}->($value);
+            return $_ if $type_constraint->($_);
         }
     }
     return $value;
 }
 
+my $serial_enum = 0;
 sub enum {
+    # enum ['small', 'medium', 'large']
+    if (ref($_[0]) eq 'ARRAY') {
+        my @elements = @{ shift @_ };
+
+        my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
+                 . ++$serial_enum;
+        enum($name, @elements);
+        return $name;
+    }
+
+    # enum size => 'small', 'medium', 'large'
     my $name = shift;
     my %is_valid = map { $_ => 1 } @_;
 
@@ -184,6 +208,22 @@ Mouse::Util::TypeConstraints - simple type constraints
 
 Returns the simple type constraints that Mouse understands.
 
+=head1 FUNCTIONS
+
+=over 4
+
+=item B<subtype 'Name' => as 'Parent' => where { } ...>
+
+=item B<subtype as 'Parent' => where { } ...>
+
+=item B<class_type ($class, ?$options)>
+
+=item B<role_type ($role, ?$options)>
+
+=item B<enum (\@values)>
+
+=back
+
 =cut