Remove the user_constraint feature from the autocoercion code

[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Meta / TypeConstraint / Autocoerce.pm

diff --git a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
index 136940d23d3008f3e32dd7549af9444a6efce074..0356cb0a29a13da9dbf80ae2415a5bba93194512 100644 (file)
--- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
+++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
@@ -9,11 +9,11 @@ LaTeX::TikZ::Meta::TypeConstraint::Autocoerce - Type constraint metaclass that a
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 SYNOPSIS
 
@@ -30,7 +30,7 @@ our $VERSION = '0.01';
      register_type_constraint(
       LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
        name   => 'X::Autocoerce',
-       parent => find_type_constraint(__PACKAGE__),
+       target => find_type_constraint(__PACKAGE__),
        mapper => sub { join '::', __PACKAGE__, 'From', $_[1] },
       );
      );
@@ -76,7 +76,7 @@ our $VERSION = '0.01';
 
 =head1 DESCRIPTION
 
-This type constraint metaclass tries to autoload a specific module when a type coercion is attempted, which is supposed to contain the actual coercion code.
+When a type coercion is attempted, this type constraint metaclass tries to autoload a specific module which is supposed to contain the actual coercion code.
 This allows you to declare types that can be replaced (through coercion) at the end user's discretion.
 
 It works with both L<Moose> and L<Mouse> by using L<Any::Moose>.
@@ -85,12 +85,13 @@ Note that you will need L<Moose::Util::TypeConstraints/register_type_constraint>
 
 =cut
 
-use Scalar::Util qw/blessed/;
+use Scalar::Util qw<blessed>;
 
 use Sub::Name ();
 
+use LaTeX::TikZ::Tools;
+
 use Any::Moose;
-use Any::Moose 'Util' => [ 'find_meta' ];
 
 =head1 RELATIONSHIPS
 
@@ -122,36 +123,28 @@ has 'mapper' => (
  required => 1,
 );
 
-=head2 C<parent>
+=head2 C<target>
 
-A type constraint that defines which objects are already valid and do not need to be coerced.
-This is somewhat different from L<Moose::Meta::TypeConstraint/parent>.
+A type constraint that defines into what the objects are going to be coerced.
+Objects satisfying this type constraint will be automatically considered as valid and will not be coerced.
 If it is given as a plain string, then a type constraint with the same name is searched for in the global type constraint registry.
 
 =cut
 
-has 'parent' => (
+has 'target' => (
  is       => 'ro',
  isa      => any_moose('Meta::TypeConstraint'),
  required => 1,
 );
 
-=head2 C<user_constraint>
-
-An optional user defined code reference which predates checking the parent 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, parent => $parent, [ 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<$parent> by loading the class returned by C<$mapper>.
+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>.
 
 =cut
 
@@ -159,43 +152,34 @@ around 'new' => sub {
  my ($orig, $class, %args) = @_;
 
  unless (exists $args{mapper}) {
-  $args{mapper} = sub { join '::', $_[0]->parent->name, $_[1] };
+  $args{mapper} = sub { join '::', $_[0]->target->name, $_[1] };
  }
 
- my $parent = delete $args{parent};
- unless (defined $parent and blessed $parent) {
-  $parent = find_meta($parent);
-  Carp::confess("No meta object for parent $parent");
-  $parent = $parent->type_constraint;
+ my $target = delete $args{target};
+ unless (blessed $target) {
+  my $target_name = defined $target ? "target $target" : 'undefined target';
+  $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('parent')
-                  ->type_constraint->assert_valid($parent);
- $args{parent} = $parent;
+ $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 parent type constraint
-  return $tc->parent->check($thing);
+  return $target->check($thing);
  });
 
- $tc = $class->$orig(%args);
+ return $class->$orig(%args);
 };
 
 =head2 C<coerce $thing>