X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=e221391138da475b37958bc190724f3a4d3408a3;hb=13cf7c3bca2fb15e1bd70443e3b980c5b857c645;hp=300a73cd127281089695252a480a5c9afd7f597a;hpb=424215da813d2b960476aaf03783383fd1231c8f;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 300a73c..e221391 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -7,7 +7,7 @@ use MooseX::Meta::TypeConstraint::Structured::Named;
 #use MooseX::Types::Moose qw();
 #use MooseX::Types -declare => [qw( Dict Tuple Optional )];
   use Sub::Exporter
-    -setup => { exports => [ qw(Dict Tuple) ] };
+    -setup => { exports => [ qw(Dict Tuple Optional) ] };
 	
 our $VERSION = '0.01';
 our $AUTHORITY = 'cpan:JJNAPIORK';
@@ -113,8 +113,12 @@ This class defines the following types and subtypes.
 
 =cut
 
-sub Tuple {
-	my ($args, $optional) = @_;
+sub Optional($) {
+    return bless {args=>shift}, 'MooseX::Types::Optional';
+}
+
+sub Tuple($) {
+	my ($args, $optional) = _normalize_args(@_);
 	my @args = @$args;
 	my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
 
@@ -131,8 +135,8 @@ sub Tuple {
 	);
 }
 
-sub Dict {
-	my ($args, $optional) = @_;
+sub Dict($) {
+	my ($args, $optional) = _normalize_args(@_);
 	my %args = @$args;
 	my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
 	
@@ -149,6 +153,21 @@ sub Dict {
 	);
 }
 
+sub _normalize_args {
+    my $args = shift @_;
+    confess "Structured Type Constraints can only accept an ArrayRef as arguments"
+     unless ref $args eq 'ARRAY';
+     
+    my @args = @$args;
+    my $last = pop @args;
+    
+    if(blessed $last && $last->isa('MooseX::Types::Optional')) {
+        return ([@args], $last->{args});
+    } else {
+        return ([@args, $last]);
+    }
+    
+}
 sub _normalize_type_constraint {
 	my $tc = shift @_;