got the basic function for Optional, but the regex is still troubled, now is having...

[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Meta / TypeConstraint / Structured / Positional.pm

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm
index 115e25a..4936743 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm
@@ -94,8 +94,12 @@ sub constraint {
     return sub {
         my @args = $self->_normalize_args(shift);
         my @signature = @{$self->signature};
-        my @optional_signature = @{$self->optional_signature}
-         if $self->has_optional_signature;
+        my @optional_signature;
+        
+        if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) {
+            my $optional = pop @signature;
+            @optional_signature = @{$optional->signature};
+        }
         
         ## First make sure all the required type constraints match        
         while( my $type_constraint = shift @signature) {
@@ -106,10 +110,13 @@ sub constraint {
         
         ## Now test the option type constraints.
         while( my $arg = shift @args) {
-            my $optional_type_constraint = shift @optional_signature;
-            if(my $error = $optional_type_constraint->validate($arg)) {
-                confess $error;
-            }              
+            if(my $optional_type_constraint = shift @optional_signature) {
+                if(my $error = $optional_type_constraint->validate($arg)) {
+                    confess $error;
+                }                              
+            } else {
+                confess "Too Many arguments for the available type constraints";
+            }
         }
         
         ## If we got this far we passed!
@@ -117,7 +124,7 @@ sub constraint {
     };
 }
 
-=head2 parse_parameter_str ($str)
+=head2 _parse_type_parameter ($str)
 
 Given a $string that is the parameter information part of a parameterized
 constraint, parses it for internal constraint information.  For example:
@@ -132,15 +139,37 @@ constraints converted to true objects.
 =cut
 
 {
+    use re "eval";
+
+    my $any;
+    my $valid_chars = qr{[\w:]};
+    my $type_atom   = qr{ $valid_chars+ };
+    
+    my $type                = qr{  $valid_chars+  (?: \[  (??{$any})  \] )? }x;
+    my $type_capture_parts  = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x;
+    my $type_with_parameter = qr{  $valid_chars+      \[  (??{$any})  \]    }x;
+    
+    my $op_union = qr{ \s* \| \s* }x;
+    my $union    = qr{ $type (?: $op_union $type )+ }x;
+    
+    ## New Stuff for structured types.
     my $comma = qr{,};
     my $indirection = qr{=>};
     my $divider_ops = qr{ $comma | $indirection }x;
-    my $structure_divider = qr{\s* $divider_ops \s*}x;
+    my $structure_divider = qr{\s* $divider_ops \s*}x;    
+    my $structure_elements = qr{ $valid_chars+ $structure_divider $type | $union }x;
 
-       sub parse_parameter_str {
+    $any = qr{  $union | $structure_elements+ | $type }x;
+
+       sub _parse_type_parameter {
                my ($class, $type_str) = @_;
-               my @type_strs = split($structure_divider, $type_str);
-               return map { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_) } @type_strs;
+        {
+            $any;
+            my @type_strs = ($type_str=~m/$union | $type/gx);
+            return map {
+                Moose::Util::TypeConstraints::find_or_create_type_constraint($_);
+            } @type_strs;
+        }
        }
 }