Hmm. I think I did something odd in here...

[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / Collection / TypeCheck.pm

diff --git a/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm b/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm
new file mode 100644 (file)
index 0000000..024ff1c
--- /dev/null
+++ b/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm
@@ -0,0 +1,86 @@
+package MooseX::AttributeHelpers::Collection::TypeCheck;
+use Exporter qw(import);
+use Carp qw(confess);
+our @EXPORT = qw(type_check);
+
+our $VERSION   = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub type_check {
+    my ($attribute, $get_values, $method) = @_;
+    if ($attribute->has_type_constraint && $attribute->type_constraint->isa(
+        'Moose::Meta::TypeConstraint::Parameterized')) { 
+        my $constraint = $attribute->type_constraint->type_parameter;
+        return sub {
+            foreach my $v ($get_values->(@_)) {
+                unless ($constraint->check($v)) {
+                    $v = 'undef' unless (defined $v);
+                    confess "Value $v didn't pass container type constraint.";
+                }
+            }
+            goto $method;
+        };
+    }
+    return $method;
+}
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::Collection::TypeCheck
+
+=head1 SYNOPSIS
+
+    use MooseX::AttributeHelpers::Collection::TypeCheck;
+
+    sub push : method {
+        my ($attr, $reader, $writer) = @_;
+        return type_check($attr, sub {@_[1,$#_]}, sub {
+            my $self = shift;
+            CORE::push(@{ $reader->($self) }, @_);
+        });
+    }
+  
+=head1 DESCRIPTION
+
+This module provides one function (type_check) which is exported by default.
+It is useful when writing method providers for that involve checks on
+parameterized types.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item type_check I<attribute, get_values, method>
+
+Attribute should be the attribute you wish to do the check on, get_values a
+method that will return the values to perform the check on, and method the
+actual provided method sans type checks.  If the attribute is not a
+parameterized type, the method will simply be returned unmodified.  If it is,
+however, the method will be wrapped with another method that checks the types
+of the values provided by get_values to ensure that they meet the type
+requirements of the provided attribute.
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no 
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Paul Driver E<lt>frodwith@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut