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