new message stack code file and bust out test
John Napiorkowski [Thu, 1 Jul 2010 14:22:59 +0000 (10:22 -0400)]
lib/MooseX/Types/Structured/MessageStack.pm [new file with mode: 0644]
t/13-deeper_error.t [new file with mode: 0644]

diff --git a/lib/MooseX/Types/Structured/MessageStack.pm b/lib/MooseX/Types/Structured/MessageStack.pm
new file mode 100644 (file)
index 0000000..38a8a34
--- /dev/null
@@ -0,0 +1,40 @@
+package MooseX::Types::Structured::MessageStack;
+use Moose;
+
+has 'level' => (
+    traits => ['Counter'],
+    is => 'ro',
+    isa => 'Num',
+    required => 0,
+    default => 0,
+    handles => {
+        inc_level => 'inc',
+        dec_level => 'dec',
+    },
+);
+
+# :level, :message, :tc
+has 'messages' => (
+    traits => ['Array'],
+    is => 'ro',
+    isa => 'ArrayRef[HashRef]',
+    required => 1,
+    default => sub { [] },
+    handles => {
+        has_messages => 'count',
+        add_message => 'push',
+        all_messages => 'elements',
+    },
+);
+
+sub as_string {
+    my @messages = (shift)->all_messages;
+    my $message = join("", map { "\n". (" " x $_->{level}) ."[+] " . $_->{message} } reverse @messages);
+    return $message;
+}
+
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/t/13-deeper_error.t b/t/13-deeper_error.t
new file mode 100644 (file)
index 0000000..79530ee
--- /dev/null
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Structured qw(Dict Tuple);
+use MooseX::Types::Moose qw(Int);
+
+my $deeper_tc = subtype
+  as Dict[
+    a => Tuple[
+        Dict[
+            a1a => Tuple[Int],
+            a1b => Tuple[Int],
+        ],
+        Dict[
+            a2a => Tuple[Int],
+            a2b => Tuple[Int],
+        ],
+    ],
+    b => Tuple[
+        Dict[
+            b1a => Tuple[Int],
+            b1b => Tuple[Int],
+        ],
+        Dict[
+            b2a => Tuple[Int],
+            b2b => Tuple[Int],
+        ],
+    ],
+  ];
+
+my $struc_to_validate = {
+    a=>[
+        {
+            a1a=>[1],
+            a1b=>[2]
+        },
+        {
+            a2a=>[3],
+            a2b=>[4]
+        }
+    ],
+    b=>[
+        {
+            b1a=>[5],
+            b1b=>['AA']
+        },
+        {
+            b2a=>[7],
+            b2b=>[8]
+        }
+    ]
+};
+
+ok my $message = $deeper_tc->validate($struc_to_validate),
+'got error message of some sort';
+
+done_testing();
+
+warn $message;