X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FMeta%2FTypeConstraint%2FAutocoerce.pm;h=0356cb0a29a13da9dbf80ae2415a5bba93194512;hb=7ba67fb7132be201995057c8102d5df578dac20c;hp=25f3879a6fcb39f57b573eb86d40173e51807f1c;hpb=ecb1d1524df9ef8b8e0452d0de3efc871c3855e8;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm index 25f3879..0356cb0 100644 --- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm +++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm @@ -137,20 +137,12 @@ has 'target' => ( required => 1, ); -=head2 C - -An optional user defined code reference which predates checking the target for validity. - -=cut - -has 'user_constraint' => ( - is => 'ro', - isa => 'Maybe[CodeRef]', -); +my $target_tc = __PACKAGE__->meta->find_attribute_by_name('target') + ->type_constraint; =head1 METHODS -=head2 C<< new name => $name, mapper => $mapper, target => $target, [ user_constraint => sub { ... } ] >> +=head2 C<< new name => $name, mapper => $mapper, target => $target >> Constructs a type constraint object that will attempt to autocoerce objects that are not valid according to C<$target> by loading the class returned by C<$mapper>. @@ -169,34 +161,25 @@ around 'new' => sub { $target = LaTeX::TikZ::Tools::type_constraint($target) if defined $target; Carp::confess("No meta object for $target_name") unless defined $target; } - __PACKAGE__->meta->find_attribute_by_name('target') - ->type_constraint->assert_valid($target); + $target_tc->assert_valid($target); $args{target} = $target; if (any_moose() eq 'Moose') { $args{coercion} = Moose::Meta::TypeCoercion->new; } - my $tc; $args{constraint} = Sub::Name::subname('_constraint' => sub { my ($thing) = @_; # Remember that when ->check is called inside coerce, a return value of 0 # means that coercion should take place, while 1 signifies that the value is - # already OK. - - # First, try a possible user defined constraint - my $user = $tc->user_constraint; - if (defined $user) { - my $ok = $user->($thing); - return 1 if $ok; - } + # already OK. Thus we should return true if and only if $thing passes the + # target type constraint. - # Then, it's valid if and only if it passes the target type constraint - return $tc->target->check($thing); + return $target->check($thing); }); - $tc = $class->$orig(%args); + return $class->$orig(%args); }; =head2 C