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.05 =cut our $VERSION = '0.05'; =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 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 => ( lazy => 1, reader => "should_coerce", default => sub { return 1 if shift->type_constraint->has_coercion; return 0; } ); 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<< >> =head1 CONTRIBUTORS Schwern: Michael G. Schwern =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. 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 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS My own stupidity, for inspiring me to write this module. Dave Rolsky, for telling me how to do it the L 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