File Coverage

blib/lib/MooseX/CoercePerAttribute.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package MooseX::CoercePerAttribute;
2              
3 6     6   2448013 use strict;
  6         15  
  6         200  
4 6     6   149 use 5.008_005;
  6         20  
  6         318  
5              
6             our $VERSION = '1.001';
7              
8 6     6   6181 use Moose::Role;
  6         1167308  
  6         42  
9 6     6   37552 use Moose::Util::TypeConstraints;
  6         15  
  6         36  
10             Moose::Util::meta_attribute_alias('CoercePerAttribute');
11              
12             before _process_coerce_option => sub {
13             my ($class, $name, $options) = @_;
14              
15             my $coercion = $options->{coerce};
16             return unless $coercion && $coercion != 1;
17              
18             # Create an anonymous subtype of the TC object so as to not mess with the existing TC
19             my $anon_subtype = $options->{type_constraint} = Moose::Meta::TypeConstraint->new(
20             parent => $options->{type_constraint},
21             );
22              
23             $class->throw_error(
24             "Couldn't build coercion from supplyed arguments for ($name)",
25             data => $coercion,
26             ) unless ((ref $coercion) =~ /ARRAY|HASH/) && $anon_subtype;
27              
28             my @coercions;
29              
30             # NOTE: Depricated behavior. Just set it to the approved usage.
31             # TODO: Remove in version 1.000
32             if (ref $coercion eq 'HASH'){
33             warn "The use of a HashRef for declaration of inline coercions is depricated. See perldoc MooseX::CoercePerAttribute. This feature will be removed in version 1.100 of MooseX::CoercePerAttribute";
34             $coercion = [
35             map { $_ => $coercion->{$_} } keys %$coercion,
36             ];
37             }
38              
39             if (ref $coercion eq 'ARRAY') {
40             while (scalar @$coercion) {
41             my $coerce_type = shift @$coercion;
42              
43             # The user can supply the coercion in its full form...
44             if (ref $coerce_type eq 'CODE'){
45             push @coercions, $coerce_type;
46             }
47              
48             # Or they can give us the pieces to make the coercion from.
49             if (!ref $coerce_type){
50             my $via = shift @$coercion;
51              
52             # Create the coercion sub ref from the list of Type => via pairs.
53             push @coercions, sub {
54             &coerce(shift, &from($coerce_type, &via($via)) )
55             };
56             }
57             }
58             }
59              
60             # Create each coercion object from a anonymous subtype
61             for my $coercion (@coercions){
62             $coercion->($anon_subtype) if ref $coercion eq 'CODE';
63             }
64              
65             $class->throw_error(
66             "Coerce for ($name) doesn't set a coercion for ($anon_subtype), see man MooseX::CoercePerAttribute for usage",
67             data => $coercion
68             ) unless $anon_subtype->has_coercion;
69             };
70              
71             1;
72             __END__
73              
74             =encoding utf-8
75              
76             =head1 NAME
77              
78             MooseX::CoercePerAttribute - Define Coercions per attribute!
79              
80             =head1 SYNOPSIS
81              
82             use MooseX::CoercePerAttribute;
83              
84             has foo => (isa => 'Str', is => 'ro', coerce => 1);
85             has bar => (
86             traits => [CoercePerAttribute],
87             isa => Bar,
88             is => 'ro',
89             coerce => [
90             Str => sub {
91             my ($value, $options);
92             ...
93             },
94             Int => sub {
95             my ($value, $options);
96             ...
97             },
98             ],
99             );
100              
101             use Moose::Util::Types;
102              
103             has baz => (
104             traits => [CoercePerAttribute],
105             isa => Baz,
106             is => 'ro',
107             coerce => [
108             sub {
109             coerce $_[0], from Str, via {}
110             }]
111             );
112              
113              
114             =head1 DESCRIPTION
115              
116             MooseX::CoercePerAttribute is a simple Moose Trait to allow you to define inline coercions per attribute.
117              
118             This module allows for coercions to be declared on a per attribute bases. Accepting either an array of Code refs of the coercion to be run or an HashRef of various arguments to create a coercion routine from.
119              
120             =head1 USAGE
121              
122             This trait allows you to declare a type coercion inline for an attribute. The Role will create an __ANON__ sub TypeConstraint object of the TypeConstraint in the attributes isa parameter. The type coercion can be supplied in one of two methods. The coercion should be supplied to the Moose Attribute coerce parameter.
123              
124             1. The recomended usage is to supply a arrayref list declaring the types to coerce from and a subref to be executed in pairs.
125             coerce => [$Fromtype1 => sub {}, $Fromtype2 => sub {}]
126              
127             2. Alternatively you can supply and arrayref of coercion coderefs. These should be in the same format as defined in L<Moose::Util::TypeConstraints> and will be passed the __ANON__ subtype as its first argument. If you use this method then you will need to use Moose::Util::TypeConstraints in you module.
128             coerce => [sub {coerce $_[0], from Str, via sub {} }]
129              
130             NB: Moose handles its coercions as an array of possible coercions. This means that it will use the first coercion in the list that matches the criteria. In earlier versions of this module the coercions were supplied as a HASHREF. This behaviour is deprecated and will be removed in later versions as it creates an uncertainty over the order of usage.
131              
132             =head1 AUTHOR
133              
134             Mike Francis E<lt>ungrim97@gmail.comE<gt>
135              
136             =head1 COPYRIGHT
137              
138             Copyright 2013- Mike Francis
139              
140             =head1 LICENSE
141              
142             This library is free software; you can redistribute it and/or modify
143             it under the same terms as Perl itself.
144              
145             =head1 SUPPORT
146              
147             You can find documentation for this module with the perldoc command.
148              
149             perldoc MooseX::CoercePerAttribute
150              
151              
152             You can also look for information at:
153              
154             =over 4
155              
156             =item * RT: CPAN's request tracker (report bugs here)
157              
158             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-CoercePerAttribute>
159              
160             =item * Meta CPAN
161              
162             L<https://metacpan.org/module/MooseX::CoercePerAttribute>
163              
164             =item * Search CPAN
165              
166             L<http://search.cpan.org/dist/MooseX-CoercePerAttribute/>
167              
168             =back
169              
170              
171             =cut