lib/MooseX/AttributeHelpers/MethodProvider/Util.pm

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