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     # MooseX::ClassAttribute is not always present in the consuming class
  75     sub add_class_attribute { }
  76
  77     around add_class_attribute => sub {
  78         my $next = shift;
  79         my $self = shift;
  80         my ($what, %opts) = @_;
  81
  82         if (exists $opts{isa}) {
  83             my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa});
  84             $opts{coerce} = 1 if not exists $opts{coerce} and $type->has_coercion;
  85         }
  86
  87         $self->$next($what, %opts);
  88     };
  89 }
  90
  91 my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods(
  92
  93     install => [ qw(import unimport) ],
  94
  95     class_metaroles => {
  96         attribute   => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'],
  97         class       => ['MooseX::AlwaysCoerce::Role::Meta::Class'],
  98     },
  99
 100     role_metaroles => {
 101         (Moose->VERSION >= 1.9900
 102             ? (applied_attribute => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'])
 103             : ()),
 104         role                => ['MooseX::AlwaysCoerce::Role::Meta::Class'],
 105     }
 106 );
 107
 108 sub init_meta {
 109     my ($class, %options) = @_;
 110     my $for_class = $options{for_class};
 111
 112     MooseX::ClassAttribute->import({ into => $for_class });
 113
 114     # call generated method to do the rest of the work.
 115     goto $init_meta;
 116 }
 117
 118 =head1 AUTHOR
 119
 120 Rafael Kitover, C<< <rkitover at cpan.org> >>
 121
 122 =head1 CONTRIBUTORS
 123
 124 Schwern: Michael G. Schwern <mschwern@cpan.org>
 125 Ether: Karen Etheridge <ether@cpan.org>
 126
 127 =head1 BUGS
 128
 129 Please report any bugs or feature requests to C<bug-moosex-alwayscoerce at rt.cpan.org>, or through
 130 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-AlwaysCoerce>.  I will be notified, and then you'll
 131 automatically be notified of progress on your bug as I make changes.
 132
 133 =head1 SUPPORT
 134
 135 You can find more information at:
 136
 137 =over 4
 138
 139 =item * RT: CPAN's request tracker
 140
 141 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-AlwaysCoerce>
 142
 143 =item * AnnoCPAN: Annotated CPAN documentation
 144
 145 L<http://annocpan.org/dist/MooseX-AlwaysCoerce>
 146
 147 =item * CPAN Ratings
 148
 149 L<http://cpanratings.perl.org/d/MooseX-AlwaysCoerce>
 150
 151 =item * Search CPAN
 152
 153 L<http://search.cpan.org/dist/MooseX-AlwaysCoerce/>
 154
 155 =back
 156
 157 =head1 ACKNOWLEDGEMENTS
 158
 159 My own stupidity, for inspiring me to write this module.
 160
 161 Dave Rolsky, for telling me how to do it the L<Moose> way.
 162
 163 =head1 COPYRIGHT & LICENSE
 164
 165 Copyright (c) 2009-2010 Rafael Kitover
 166
 167 This program is free software; you can redistribute it and/or modify it
 168 under the same terms as Perl itself.
 169
 170 =cut
 171
 172 1; # End of MooseX::AlwaysCoerce
 173 # vim:et sts=4 sw=4 tw=0: