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.02
  22
  23 =cut
  24
  25 our $VERSION = '0.02';
  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 =cut
  49
  50 {
  51     package MooseX::AlwaysCoerce::Role::Meta::Attribute;
  52     use namespace::autoclean;
  53     use Moose::Role;
  54
  55     has coerce => (is => 'rw', default => 1);
  56
  57     package MooseX::AlwaysCoerce::Role::Meta::Class;
  58     use namespace::autoclean;
  59     use Moose::Role;
  60
  61     around add_class_attribute => sub {
  62         my $next = shift;
  63         my $self = shift;
  64         $self->$next(@_, coerce => 1);
  65     };
  66 }
  67
  68 sub init_meta {
  69     shift;
  70     my %options = @_;
  71     my $for_class = $options{for_class};
  72
  73     MooseX::ClassAttribute->import({ into => $for_class });
  74
  75     Moose::Util::MetaRole::apply_metaclass_roles(
  76         for_class => $for_class,
  77         attribute_metaclass_roles =>
  78             ['MooseX::AlwaysCoerce::Role::Meta::Attribute'],
  79         metaclass_roles =>
  80             ['MooseX::AlwaysCoerce::Role::Meta::Class'],
  81     );
  82
  83     return $for_class->meta;
  84 }
  85
  86 =head1 AUTHOR
  87
  88 Rafael Kitover, C<< <rkitover at cpan.org> >>
  89
  90 =head1 BUGS
  91
  92 Please report any bugs or feature requests to C<bug-moosex-alwayscoerce at rt.cpan.org>, or through
  93 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-AlwaysCoerce>.  I will be notified, and then you'll
  94 automatically be notified of progress on your bug as I make changes.
  95
  96 =head1 SUPPORT
  97
  98 You can find more information at:
  99
 100 =over 4
 101
 102 =item * RT: CPAN's request tracker
 103
 104 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-AlwaysCoerce>
 105
 106 =item * AnnoCPAN: Annotated CPAN documentation
 107
 108 L<http://annocpan.org/dist/MooseX-AlwaysCoerce>
 109
 110 =item * CPAN Ratings
 111
 112 L<http://cpanratings.perl.org/d/MooseX-AlwaysCoerce>
 113
 114 =item * Search CPAN
 115
 116 L<http://search.cpan.org/dist/MooseX-AlwaysCoerce/>
 117
 118 =back
 119
 120 =head1 ACKNOWLEDGEMENTS
 121
 122 My own stupidity, for inspiring me to write this module.
 123
 124 Dave Rolsky, for telling me how to do it the L<Moose> way.
 125
 126 =head1 COPYRIGHT & LICENSE
 127
 128 Copyright (c) 2009 Rafael Kitover
 129
 130 This program is free software; you can redistribute it and/or modify it
 131 under the same terms as Perl itself.
 132
 133 =cut
 134
 135 1; # End of MooseX::AlwaysCoerce