X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeCoercion.pm;h=6ecafba3acf51b145b320b8e479cb781de6feace;hb=HEAD;hp=646044dfd76a42e2e622862378ec1e11c2094540;hpb=722c9bcbe9633bbebe5b71773b8d8e574385b604;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeCoercion.pm b/lib/Moose/Meta/TypeCoercion.pm index 646044d..6ecafba 100644 --- a/lib/Moose/Meta/TypeCoercion.pm +++ b/lib/Moose/Meta/TypeCoercion.pm @@ -8,30 +8,29 @@ use metaclass; use Moose::Meta::Attribute; use Moose::Util::TypeConstraints (); -our $VERSION = '0.71'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - __PACKAGE__->meta->add_attribute('type_coercion_map' => ( reader => 'type_coercion_map', - default => sub { [] } + default => sub { [] }, + Class::MOP::_definition_context(), )); __PACKAGE__->meta->add_attribute( Moose::Meta::Attribute->new('type_constraint' => ( reader => 'type_constraint', - weak_ref => 1 + weak_ref => 1, + Class::MOP::_definition_context(), )) ); # private accessor __PACKAGE__->meta->add_attribute('compiled_type_coercion' => ( - accessor => '_compiled_type_coercion' + accessor => '_compiled_type_coercion', + Class::MOP::_definition_context(), )); -sub new { +sub new { my $class = shift; - my $self = $class->meta->new_object(@_); + my $self = Class::MOP::class_of($class)->new_object(@_); $self->compile_type_coercion; return $self; } @@ -43,24 +42,28 @@ sub compile_type_coercion { while (@coercion_map) { my ($constraint_name, $action) = splice(@coercion_map, 0, 2); my $type_constraint = ref $constraint_name ? $constraint_name : Moose::Util::TypeConstraints::find_or_parse_type_constraint($constraint_name); - (defined $type_constraint) - || Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from"); - push @coercions => [ - $type_constraint->_compiled_type_constraint, - $action + + unless ( defined $type_constraint ) { + require Moose; + Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from"); + } + + push @coercions => [ + $type_constraint->_compiled_type_constraint, + $action ]; } - $self->_compiled_type_coercion(sub { + $self->_compiled_type_coercion(sub { my $thing = shift; foreach my $coercion (@coercions) { my ($constraint, $converter) = @$coercion; if ($constraint->($thing)) { - local $_ = $thing; + local $_ = $thing; return $converter->($thing); } } return $thing; - }); + }); } sub has_coercion_for_type { @@ -71,19 +74,21 @@ sub has_coercion_for_type { sub add_type_coercions { my ($self, @new_coercion_map) = @_; - - my $coercion_map = $self->type_coercion_map; + + my $coercion_map = $self->type_coercion_map; my %has_coercion = @$coercion_map; - + while (@new_coercion_map) { - my ($constraint_name, $action) = splice(@new_coercion_map, 0, 2); - - Moose->throw_error("A coercion action already exists for '$constraint_name'") - if exists $has_coercion{$constraint_name}; - + my ($constraint_name, $action) = splice(@new_coercion_map, 0, 2); + + if ( exists $has_coercion{$constraint_name} ) { + require Moose; + Moose->throw_error("A coercion action already exists for '$constraint_name'") + } + push @{$coercion_map} => ($constraint_name, $action); } - + # and re-compile ... $self->compile_type_coercion; } @@ -93,64 +98,79 @@ sub coerce { $_[0]->_compiled_type_coercion->($_[1]) } 1; +# ABSTRACT: The Moose Type Coercion metaclass + __END__ =pod -=head1 NAME - -Moose::Meta::TypeCoercion - The Moose Type Coercion metaclass - =head1 DESCRIPTION -For the most part, the only time you will ever encounter an -instance of this class is if you are doing some serious deep -introspection. This API should not be considered final, but -it is B that this will matter to a regular -Moose user. +A type coercion object is basically a mapping of one or more type +constraints and the associated coercions subroutines. -If you wish to use features at this depth, please come to the -#moose IRC channel on irc.perl.org and we can talk :) +It's unlikely that you will need to instantiate an object of this +class directly, as it's part of the deep internals of Moose. =head1 METHODS =over 4 -=item B +=item B<< Moose::Meta::TypeCoercion->new(%options) >> -=item B +Creates a new type coercion object, based on the options provided. -=item B +=over 8 -=item B +=item * type_constraint -=item B +This is the L object for the type that is +being coerced I. -=item B +=back -=item B +=item B<< $coercion->type_coercion_map >> -=item B +This returns the map of type constraints to coercions as an array +reference. The values of the array alternate between type names and +subroutine references which implement the coercion. -=back +The value is an array reference because coercions are tried in the +order they are added. -=head1 BUGS +=item B<< $coercion->type_constraint >> + +This returns the L that was passed to the +constructor. + +=item B<< $coercion->has_coercion_for_type($type_name) >> + +Returns true if the coercion can coerce the named type. -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +=item B<< $coercion->add_type_coercions( $type_name => $sub, ... ) >> -=head1 AUTHOR +This method takes a list of type names and subroutine references. If +the coercion already has a mapping for a given type, it throws an +exception. -Stevan Little Estevan@iinteractive.comE +Coercions are actually -=head1 COPYRIGHT AND LICENSE +=item B<< $coercion->coerce($value) >> -Copyright 2006-2009 by Infinity Interactive, Inc. +This method takes a value and applies the first valid coercion it +finds. -L +This means that if the value could belong to more than type in the +coercion object, the first coercion added is used. + +=item B<< Moose::Meta::TypeCoercion->meta >> + +This will return a L instance for this class. + +=back + +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut