changes for 0.16 release
[gitmo/MooseX-AlwaysCoerce.git] / lib / MooseX / AlwaysCoerce.pm
1 package MooseX::AlwaysCoerce;
2
3 use strict;
4 use warnings;
5
6 use namespace::autoclean;
7 use Moose ();
8 use MooseX::ClassAttribute ();
9 use Moose::Exporter;
10 use Moose::Util::MetaRole;
11 use Carp;
12
13 Moose::Exporter->setup_import_methods;
14
15 =head1 NAME
16
17 MooseX::AlwaysCoerce - Automatically enable coercions for Moose attributes
18
19 =head1 VERSION
20
21 Version 0.16
22
23 =cut
24
25 our $VERSION = '0.16';
26
27 =head1 SYNOPSIS
28
29     package MyClass;
30
31     use Moose;
32     use MooseX::AlwaysCoerce;
33     use MyTypeLib 'SomeType';
34
35     has foo => (is => 'rw', isa => SomeType); # coerce => 1 automatically added
36
37     # same, MooseX::ClassAttribute is automatically applied
38     class_has bar => (is => 'rw', isa => SomeType);
39
40 =head1 DESCRIPTION
41
42 Have you ever spent an hour or more trying to figure out "WTF, why did my
43 coercion not run?" only to find out that you forgot C<< coerce => 1 >> ?
44
45 Just load this module in your L<Moose> class and C<< coerce => 1 >> will be
46 enabled for every attribute and class attribute automatically.
47
48 Use C<< coerce => 0 >> to disable a coercion explicitly.
49
50 =cut
51
52 {
53     package MooseX::AlwaysCoerce::Role::Meta::Attribute;
54     use namespace::autoclean;
55     use Moose::Role;
56
57     around should_coerce => sub {
58         my $orig = shift;
59         my $self = shift;
60
61         my $current_val = $self->$orig(@_);
62
63         return $current_val if defined $current_val;
64
65         return 1 if $self->type_constraint && $self->type_constraint->has_coercion;
66         return 0;
67     };
68
69     package MooseX::AlwaysCoerce::Role::Meta::Class;
70     use namespace::autoclean;
71     use Moose::Role;
72     use Moose::Util::TypeConstraints;
73
74     around add_class_attribute => sub {
75         my $next = shift;
76         my $self = shift;
77         my ($what, %opts) = @_;
78
79         if (exists $opts{isa}) {
80             my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa});
81             $opts{coerce} = 1 if not exists $opts{coerce} and $type->has_coercion;
82         }
83
84         $self->$next($what, %opts);
85     };
86 }
87
88 my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods(
89
90     install => [ qw(import unimport) ],
91
92     class_metaroles => {
93         attribute   => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'],
94         class       => ['MooseX::AlwaysCoerce::Role::Meta::Class'],
95     },
96
97     role_metaroles => {
98         (Moose->VERSION >= 1.9900
99             ? (applied_attribute => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'])
100             : ()),
101         role                => ['MooseX::AlwaysCoerce::Role::Meta::Class'],
102     }
103 );
104
105 sub init_meta {
106     my ($class, %options) = @_;
107     my $for_class = $options{for_class};
108
109     MooseX::ClassAttribute->import({ into => $for_class });
110
111     # call generated method to do the rest of the work.
112     goto $init_meta;
113 }
114
115 =head1 AUTHOR
116
117 Rafael Kitover, C<< <rkitover at cpan.org> >>
118
119 =head1 CONTRIBUTORS
120
121 Schwern: Michael G. Schwern <mschwern@cpan.org>
122 Ether: Karen Etheridge <ether@cpan.org>
123
124 =head1 BUGS
125
126 Please report any bugs or feature requests to C<bug-moosex-alwayscoerce at rt.cpan.org>, or through
127 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-AlwaysCoerce>.  I will be notified, and then you'll
128 automatically be notified of progress on your bug as I make changes.
129
130 =head1 SUPPORT
131
132 You can find more information at:
133
134 =over 4
135
136 =item * RT: CPAN's request tracker
137
138 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-AlwaysCoerce>
139
140 =item * AnnoCPAN: Annotated CPAN documentation
141
142 L<http://annocpan.org/dist/MooseX-AlwaysCoerce>
143
144 =item * CPAN Ratings
145
146 L<http://cpanratings.perl.org/d/MooseX-AlwaysCoerce>
147
148 =item * Search CPAN
149
150 L<http://search.cpan.org/dist/MooseX-AlwaysCoerce/>
151
152 =back
153
154 =head1 ACKNOWLEDGEMENTS
155
156 My own stupidity, for inspiring me to write this module.
157
158 Dave Rolsky, for telling me how to do it the L<Moose> way.
159
160 =head1 COPYRIGHT & LICENSE
161
162 Copyright (c) 2009-2010 Rafael Kitover
163
164 This program is free software; you can redistribute it and/or modify it
165 under the same terms as Perl itself.
166
167 =cut
168
169 1; # End of MooseX::AlwaysCoerce
170 # vim:et sts=4 sw=4 tw=0: