X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FAlwaysCoerce.pm;h=0ee3cecfeaf0b5a5e9bd0b2e24635ee669ea9c66;hb=53f6ab6c200cdebbe8cc4a5b2afe65b1f6d0b4fe;hp=b8ca8078178f5cccdcf65b8ef117b45143c58fa1;hpb=b058bf611520d8f60af9252d77886af53a907c3c;p=gitmo%2FMooseX-AlwaysCoerce.git diff --git a/lib/MooseX/AlwaysCoerce.pm b/lib/MooseX/AlwaysCoerce.pm index b8ca807..0ee3cec 100644 --- a/lib/MooseX/AlwaysCoerce.pm +++ b/lib/MooseX/AlwaysCoerce.pm @@ -18,11 +18,11 @@ MooseX::AlwaysCoerce - Automatically enable coercions for Moose attributes =head1 VERSION -Version 0.04 +Version 0.12 =cut -our $VERSION = '0.04'; +our $VERSION = '0.14'; =head1 SYNOPSIS @@ -54,15 +54,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,29 +76,40 @@ 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; } =head1 AUTHOR @@ -106,6 +119,7 @@ Rafael Kitover, C<< >> =head1 CONTRIBUTORS Schwern: Michael G. Schwern +Ether: Karen Etheridge =head1 BUGS @@ -145,7 +159,7 @@ 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. @@ -153,3 +167,4 @@ under the same terms as Perl itself. =cut 1; # End of MooseX::AlwaysCoerce +# vim:et sts=4 sw=4 tw=0: