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