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 |