lib/MooseX/AlwaysCoerce.pm

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