add maybe_doctype

2 files changed, 57 insertions, 4 deletions

diff --git a/lib/MooseX/Meta/TypeConstraint/Doctype.pm b/lib/MooseX/Meta/TypeConstraint/Doctype.pm
index cc48312..18dfd7c 100644
--- a/lib/MooseX/Meta/TypeConstraint/Doctype.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Doctype.pm
@@ -84,6 +84,11 @@ has doctype => (
     required => 1,
 );
 
+has maybe => (
+    is  => 'ro',
+    isa => 'Bool',
+);
+
 has '+parent' => (
     default => sub { find_type_constraint('Ref') },
 );
@@ -116,7 +121,10 @@ sub _validate_doctype {
 
     match_on_type $doctype => (
         'HashRef' => sub {
-            if (!find_type_constraint('HashRef')->check($data)) {
+            if ($self->maybe && !defined($data)) {
+                # ignore it
+            }
+            elsif (!find_type_constraint('HashRef')->check($data)) {
                 $errors = $self->_format_error($data, $prefix);
             }
             else {
@@ -146,7 +154,10 @@ sub _validate_doctype {
             }
         },
         'ArrayRef' => sub {
-            if (!find_type_constraint('ArrayRef')->check($data)) {
+            if ($self->maybe && !defined($data)) {
+                # ignore it
+            }
+            elsif (!find_type_constraint('ArrayRef')->check($data)) {
                 $errors = $self->_format_error($data, $prefix);
             }
             else {
diff --git a/lib/MooseX/Validation/Doctypes.pm b/lib/MooseX/Validation/Doctypes.pm
index ab19476..8de8696 100644
--- a/lib/MooseX/Validation/Doctypes.pm
+++ b/lib/MooseX/Validation/Doctypes.pm
@@ -6,9 +6,9 @@ use warnings;
 use MooseX::Meta::TypeConstraint::Doctype;
 
 use Sub::Exporter -setup => {
-    exports => ['doctype'],
+    exports => ['doctype', 'maybe_doctype'],
     groups => {
-        default => ['doctype'],
+        default => ['doctype', 'maybe_doctype'],
     },
 };
 
@@ -108,6 +108,48 @@ sub doctype {
     return $tc;
 }
 
+=func maybe_doctype $name, $doctype
+
+Identical to C<doctype>, except that undefined values are also allowed. This is
+useful when nesting doctypes, as in:
+
+  doctype 'Person' => {
+      id      => 'Str',
+      name    => maybe_doctype({
+          first => 'Str',
+          last  => 'Str',
+      }),
+      address => 'Str',
+  };
+
+This way, C<< { first => 'Bob', last => 'Smith' } >> is a valid name, and it's
+also valid to not provide a name, but an invalid name will still throw an
+error.
+
+=cut
+
+sub maybe_doctype {
+    my $name;
+    $name = shift if @_ > 1;
+
+    my ($doctype) = @_;
+
+    # XXX validate name
+
+    my $args = {
+        ($name ? (name => $name) : ()),
+        doctype            => $doctype,
+        package_defined_in => scalar(caller),
+        maybe              => 1,
+    };
+
+    my $tc = MooseX::Meta::TypeConstraint::Doctype->new($args);
+    Moose::Util::TypeConstraints::register_type_constraint($tc)
+        if $name;
+
+    return $tc;
+}
+
 =head1 BUGS
 
 No known bugs.