Factor the 'target' type constraint outside of L::T::M::TC::A->new

[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 f335cb95f108fd787c4a82a5efba913713f43bdf..00fbbf4a547ac485aa787a15defb9fdc92d651d2 100644 (file)
--- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
+++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
@@ -30,7 +30,7 @@ our $VERSION = '0.02';
      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.02';
 
 =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,23 +123,26 @@ 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,
 );
 
+my $target_tc = __PACKAGE__->meta->find_attribute_by_name('target')
+                                 ->type_constraint;
+
 =head2 C<user_constraint>
 
-An optional user defined code reference which predates checking the parent for validity.
+An optional user defined code reference which predates checking the target for validity.
 
 =cut
 
@@ -149,9 +153,9 @@ has 'user_constraint' => (
 
 =head1 METHODS
 
-=head2 C<< new name => $name, mapper => $mapper, parent => $parent, [ user_constraint => sub { ... } ] >>
+=head2 C<< new name => $name, mapper => $mapper, target => $target, [ user_constraint => sub { ... } ] >>
 
-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,18 +163,17 @@ 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;
@@ -191,8 +194,8 @@ around 'new' => sub {
    return 1 if $ok;
   }
 
-  # Then, it's valid if and only if it passes the parent type constraint
-  return $tc->parent->check($thing);
+  # Then, it's valid if and only if it passes the target type constraint
+  return $tc->target->check($thing);
  });
 
  $tc = $class->$orig(%args);