Created
June 27, 2010 23:36
-
-
Save schwern/455265 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| package MooseX::AlwaysCoerce; | |
| use strict; | |
| use warnings; | |
| use namespace::autoclean; | |
| use Moose (); | |
| use MooseX::ClassAttribute (); | |
| use Moose::Exporter; | |
| use Moose::Util::MetaRole; | |
| use Carp; | |
| Moose::Exporter->setup_import_methods; | |
| =head1 NAME | |
| MooseX::AlwaysCoerce - Automatically enable coercions for Moose attributes | |
| =head1 VERSION | |
| Version 0.04 | |
| =cut | |
| our $VERSION = '0.04'; | |
| =head1 SYNOPSIS | |
| package MyClass; | |
| use Moose; | |
| use MooseX::AlwaysCoerce; | |
| use MyTypeLib 'SomeType'; | |
| has foo => (is => 'rw', isa => SomeType); # coerce => 1 automatically added | |
| # same, MooseX::ClassAttribute is automatically applied | |
| class_has bar => (is => 'rw', isa => SomeType); | |
| =head1 DESCRIPTION | |
| Have you ever spent an hour or more trying to figure out "WTF, why did my | |
| coercion not run?" only to find out that you forgot C<< coerce => 1 >> ? | |
| Just load this module in your L<Moose> class and C<< coerce => 1 >> will be | |
| enabled for every attribute and class attribute automatically. | |
| Use C<< coerce => 0 >> to disable a coercion explicitly. | |
| =cut | |
| { | |
| package MooseX::AlwaysCoerce::Role::Meta::Attribute; | |
| use namespace::autoclean; | |
| use Moose::Role; | |
| has coerce => ( | |
| is => 'rw', | |
| default => sub { | |
| $DB::single = 1; | |
| return 1 if shift->type_constraint->has_coercion; | |
| return 0; | |
| } | |
| ); | |
| sub BUILD {} | |
| around BUILD => sub { | |
| print "BUILD called\n"; | |
| }; | |
| package MooseX::AlwaysCoerce::Role::Meta::Class; | |
| use namespace::autoclean; | |
| use Moose::Role; | |
| use Moose::Util::TypeConstraints; | |
| around add_class_attribute => sub { | |
| my $next = shift; | |
| my $self = shift; | |
| my ($what, %opts) = @_; | |
| my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa}); | |
| $opts{coerce} = 1 if !exists $opts{coerce} and $type->has_coercion; | |
| $self->$next($what, %opts); | |
| }; | |
| } | |
| sub init_meta { | |
| shift; | |
| my %options = @_; | |
| my $for_class = $options{for_class}; | |
| MooseX::ClassAttribute->import({ into => $for_class }); | |
| Moose::Util::MetaRole::apply_metaclass_roles( | |
| for_class => $for_class, | |
| attribute_metaclass_roles => | |
| ['MooseX::AlwaysCoerce::Role::Meta::Attribute'], | |
| metaclass_roles => | |
| ['MooseX::AlwaysCoerce::Role::Meta::Class'], | |
| ); | |
| return $for_class->meta; | |
| } | |
| =head1 AUTHOR | |
| Rafael Kitover, C<< <rkitover at cpan.org> >> | |
| =head1 BUGS | |
| Please report any bugs or feature requests to C<bug-moosex-alwayscoerce at rt.cpan.org>, or through | |
| the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-AlwaysCoerce>. I will be notified, and then you'll | |
| automatically be notified of progress on your bug as I make changes. | |
| =head1 SUPPORT | |
| You can find more information at: | |
| =over 4 | |
| =item * RT: CPAN's request tracker | |
| L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-AlwaysCoerce> | |
| =item * AnnoCPAN: Annotated CPAN documentation | |
| L<http://annocpan.org/dist/MooseX-AlwaysCoerce> | |
| =item * CPAN Ratings | |
| L<http://cpanratings.perl.org/d/MooseX-AlwaysCoerce> | |
| =item * Search CPAN | |
| L<http://search.cpan.org/dist/MooseX-AlwaysCoerce/> | |
| =back | |
| =head1 ACKNOWLEDGEMENTS | |
| My own stupidity, for inspiring me to write this module. | |
| Dave Rolsky, for telling me how to do it the L<Moose> way. | |
| =head1 COPYRIGHT & LICENSE | |
| Copyright (c) 2009 Rafael Kitover | |
| This program is free software; you can redistribute it and/or modify it | |
| under the same terms as Perl itself. | |
| =cut | |
| 1; # End of MooseX::AlwaysCoerce |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment