X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FAlwaysCoerce.pm;h=b86935dd284fcf25573f1d7e92a94c028ec655bc;hb=c3fabb0cc7d9ef9f8e29431b271675f9693ab3cb;hp=0f2c39898465a05883dead7347a5c8047d783b43;hpb=dd11ea452cdae2f2949376f1d8c1bfc73577fad5;p=gitmo%2FMooseX-AlwaysCoerce.git diff --git a/lib/MooseX/AlwaysCoerce.pm b/lib/MooseX/AlwaysCoerce.pm index 0f2c398..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.06 - -=cut - -our $VERSION = '0.06'; - =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,19 +70,30 @@ 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 { @@ -99,6 +106,13 @@ sub init_meta { goto $init_meta; } +1; +# vim:et sts=4 sw=4 tw=0: +__END__ + +=for Pod::Coverage + init_meta + =head1 AUTHOR Rafael Kitover, C<< >> @@ -152,5 +166,3 @@ 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