X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FAlwaysCoerce.pm;h=b86935dd284fcf25573f1d7e92a94c028ec655bc;hb=c3fabb0cc7d9ef9f8e29431b271675f9693ab3cb;hp=3fbfd5971e83af356a280bf11a6ee2d6b6b5a403;hpb=9e804fe12e784d73f58f24ca322b5ae8405f3f5e;p=gitmo%2FMooseX-AlwaysCoerce.git diff --git a/lib/MooseX/AlwaysCoerce.pm b/lib/MooseX/AlwaysCoerce.pm index 3fbfd59..b86935d 100644 --- a/lib/MooseX/AlwaysCoerce.pm +++ b/lib/MooseX/AlwaysCoerce.pm @@ -3,27 +3,21 @@ package MooseX::AlwaysCoerce; use strict; use warnings; -use namespace::autoclean; +use namespace::autoclean 0.12; use Moose (); -use MooseX::ClassAttribute (); +use MooseX::ClassAttribute 0.24 (); use Moose::Exporter; use Moose::Util::MetaRole; use Carp; Moose::Exporter->setup_import_methods; +=pod + =head1 NAME MooseX::AlwaysCoerce - Automatically enable coercions for Moose attributes -=head1 VERSION - -Version 0.05 - -=cut - -our $VERSION = '0.05'; - =head1 SYNOPSIS package MyClass; @@ -54,15 +48,17 @@ Use C<< coerce => 0 >> to disable a coercion explicitly. use namespace::autoclean; use Moose::Role; - has coerce => ( - lazy => 1, - reader => "should_coerce", - default => sub { - return 1 if shift->type_constraint->has_coercion; - return 0; - } - ); + around should_coerce => sub { + my $orig = shift; + my $self = shift; + + my $current_val = $self->$orig(@_); + + return $current_val if defined $current_val; + return 1 if $self->type_constraint && $self->type_constraint->has_coercion; + return 0; + }; package MooseX::AlwaysCoerce::Role::Meta::Class; use namespace::autoclean; @@ -74,31 +70,49 @@ Use C<< coerce => 0 >> to disable a coercion explicitly. my $self = shift; my ($what, %opts) = @_; - my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa}); - $opts{coerce} = 1 if !exists $opts{coerce} and $type->has_coercion; + if (exists $opts{isa}) { + my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa}); + $opts{coerce} = 1 if not exists $opts{coerce} and $type->has_coercion; + } $self->$next($what, %opts); }; } +my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods( + + install => [ qw(import unimport) ], + + class_metaroles => { + attribute => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'], + class => ['MooseX::AlwaysCoerce::Role::Meta::Class'], + }, + + role_metaroles => { + (Moose->VERSION >= 1.9900 + ? (applied_attribute => ['MooseX::AlwaysCoerce::Role::Meta::Attribute']) + : ()), + role => ['MooseX::AlwaysCoerce::Role::Meta::Class'], + } +); + sub init_meta { - shift; - my %options = @_; + my ($class, %options) = @_; my $for_class = $options{for_class}; MooseX::ClassAttribute->import({ into => $for_class }); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $for_class, - attribute_metaclass_roles => - ['MooseX::AlwaysCoerce::Role::Meta::Attribute'], - metaclass_roles => - ['MooseX::AlwaysCoerce::Role::Meta::Class'], - ); - - return $for_class->meta; + # call generated method to do the rest of the work. + goto $init_meta; } +1; +# vim:et sts=4 sw=4 tw=0: +__END__ + +=for Pod::Coverage + init_meta + =head1 AUTHOR Rafael Kitover, C<< >> @@ -106,6 +120,7 @@ Rafael Kitover, C<< >> =head1 CONTRIBUTORS Schwern: Michael G. Schwern +Ether: Karen Etheridge =head1 BUGS @@ -145,11 +160,9 @@ Dave Rolsky, for telling me how to do it the L way. =head1 COPYRIGHT & LICENSE -Copyright (c) 2009 Rafael Kitover +Copyright (c) 2009-2010 Rafael Kitover This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut - -1; # End of MooseX::AlwaysCoerce