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] },
);
);
coerce => 1,
handles => [ 'id' ],
);
- __PACKAGE__->meta->make_immutable;
+ # This class shouldn't be immutable when using Moose, or the
+ # coercing attributes will not be updated with the future coercions.
+ __PACKAGE__->meta->make_immutable if any_moose() ne 'Moose';
}
# Another class the user wants to use instead of X (cannot be changed)
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
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 (blessed $parent) {
- my $parent_name = defined $parent ? "parent $parent" : 'undefined parent';
- $parent = LaTeX::TikZ::Tools::type_constraint($parent) if defined $parent;
- Carp::confess("No meta object for $parent_name") unless defined $parent;
+ 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>