lib/MooseX/AlwaysCoerce.pm

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