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