lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm

   1 package MooseX::AttributeHelpers::Collection::TypeCheck;
   2 use Exporter qw(import);
   3 use Carp qw(confess);
   4 our @EXPORT = qw(type_check);
   5
   6 our $VERSION   = '0.01';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 sub type_check {
  10     my ($attribute, $get_values, $method) = @_;
  11     if ($attribute->has_type_constraint && $attribute->type_constraint->isa(
  12         'Moose::Meta::TypeConstraint::Parameterized')) {
  13         my $constraint = $attribute->type_constraint->type_parameter;
  14         return sub {
  15             foreach my $v ($get_values->(@_)) {
  16                 unless ($constraint->check($v)) {
  17                     $v = 'undef' unless (defined $v);
  18                     confess "Value $v didn't pass container type constraint.";
  19                 }
  20             }
  21             goto $method;
  22         };
  23     }
  24     return $method;
  25 }
  26
  27 =pod
  28
  29 =head1 NAME
  30
  31 MooseX::AttributeHelpers::Collection::TypeCheck
  32
  33 =head1 SYNOPSIS
  34
  35     use MooseX::AttributeHelpers::Collection::TypeCheck;
  36
  37     sub push : method {
  38         my ($attr, $reader, $writer) = @_;
  39         return type_check($attr, sub {@_[1,$#_]}, sub {
  40             my $self = shift;
  41             CORE::push(@{ $reader->($self) }, @_);
  42         });
  43     }
  44
  45 =head1 DESCRIPTION
  46
  47 This module provides one function (type_check) which is exported by default.
  48 It is useful when writing method providers for that involve checks on
  49 parameterized types.
  50
  51 =head1 SUBROUTINES
  52
  53 =over 4
  54
  55 =item type_check I<attribute, get_values, method>
  56
  57 Attribute should be the attribute you wish to do the check on, get_values a
  58 method that will return the values to perform the check on, and method the
  59 actual provided method sans type checks.  If the attribute is not a
  60 parameterized type, the method will simply be returned unmodified.  If it is,
  61 however, the method will be wrapped with another method that checks the types
  62 of the values provided by get_values to ensure that they meet the type
  63 requirements of the provided attribute.
  64
  65 =back
  66
  67 =head1 BUGS
  68
  69 All complex software has bugs lurking in it, and this module is no
  70 exception. If you find a bug please either email me, or add the bug
  71 to cpan-RT.
  72
  73 =head1 AUTHOR
  74
  75 Paul Driver E<lt>frodwith@cpan.orgE<gt>
  76
  77 =head1 COPYRIGHT AND LICENSE
  78
  79 Copyright 2007-2008 by Infinity Interactive, Inc.
  80
  81 L<http://www.iinteractive.com>
  82
  83 This library is free software; you can redistribute it and/or modify
  84 it under the same terms as Perl itself.
  85
  86 =cut