]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blobdiff - lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
Just use Mouse instead of Any::Moose
[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Meta / TypeConstraint / Autocoerce.pm
index f335cb95f108fd787c4a82a5efba913713f43bdf..dca3e69a36aab47468811f7586c376435a176105 100644 (file)
@@ -20,17 +20,17 @@ our $VERSION = '0.02';
     # The target class of the autocoercion (cannot be changed)
     {
      package X;
-     use Any::Moose;
+     use Mouse;
      has 'id' => (
       is  => 'ro',
       isa => 'Int',
      );
      use LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
-     use Any::Moose 'Util::TypeConstraints';
+     use Mouse::Util::TypeConstraints;
      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] },
       );
      );
@@ -40,7 +40,7 @@ our $VERSION = '0.02';
     # The class that does the coercion (cannot be changed)
     {
      package Y;
-     use Any::Moose;
+     use Mouse;
      has 'x' => (
       is      => 'ro',
       isa     => 'X::Autocoerce',
@@ -53,7 +53,7 @@ our $VERSION = '0.02';
     # Another class the user wants to use instead of X (cannot be changed)
     {
      package Z;
-     use Any::Moose;
+     use Mouse;
      has 'id' => (
       is  => 'ro',
       isa => 'Num',
@@ -64,7 +64,7 @@ our $VERSION = '0.02';
     # The autocoercion class, defined by the user in X/From/Z.pm
     {
      package X::From::Z;
-     use Any::Moose 'Util::TypeConstraints';
+     use Mouse::Util::TypeConstraints;
      coerce 'X::Autocoerce'
          => from 'Z'
          => via { X->new(id => int $_->id) };
@@ -76,29 +76,30 @@ 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>.
+It only supports L<Mouse> currently.
 
-Note that you will need L<Moose::Util::TypeConstraints/register_type_constraint> or L<Mouse::Util::TypeConstraints/register_type_constraint> to install this type constraint, and that the latter is only available starting L<Mouse> C<0.63>.
+Note that you will need L<Mouse::Util::TypeConstraints/register_type_constraint> to install this type constraint, which is only available starting L<Mouse> C<0.63>.
 
 =cut
 
-use Scalar::Util qw/blessed/;
+use Scalar::Util qw<blessed>;
 
 use Sub::Name ();
 
-use Any::Moose;
-use Any::Moose 'Util' => [ 'find_meta' ];
+use LaTeX::TikZ::Tools;
+
+use Mouse;
 
 =head1 RELATIONSHIPS
 
-This class inherits from L<Moose::Meta::TypeConstraint> or L<Mouse::Meta::TypeConstraint>, depending on which mode L<Any::Moose> runs.
+This class inherits from L<Mouse::Meta::TypeConstraint>.
 
 =cut
 
-extends any_moose('Meta::TypeConstraint');
+extends 'Mouse::Meta::TypeConstraint';
 
 =head1 ATTRIBUTES
 
@@ -107,7 +108,7 @@ extends any_moose('Meta::TypeConstraint');
 The name of the type constraint.
 This must be the target of both the classes that want to use the autocoercion feature and the user defined coercions in the autoloaded classes.
 
-This attribute is inherited from the L<Moose> or L<Mouse> type constraint metaclass.
+This attribute is inherited from the L<Mouse> type constraint metaclass.
 
 =head2 C<mapper>
 
@@ -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'),
+ isa      => 'Mouse::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,30 @@ around 'new' => sub {
  my ($orig, $class, %args) = @_;
 
  unless (exists $args{mapper}) {
-  $args{mapper} = sub { join '::', $_[0]->parent->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;
+  $args{mapper} = sub { join '::', $_[0]->target->name, $_[1] };
  }
- __PACKAGE__->meta->find_attribute_by_name('parent')
-                  ->type_constraint->assert_valid($parent);
- $args{parent} = $parent;
 
- if (any_moose() eq 'Moose') {
-  $args{coercion} = Moose::Meta::TypeCoercion->new;
+ 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;
  }
+ $target_tc->assert_valid($target);
+ $args{target} = $target;
 
- 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>
@@ -247,7 +227,7 @@ __PACKAGE__->meta->make_immutable(
 
 =head1 SEE ALSO
 
-L<Moose::Meta::TypeConstraint>, L<Mouse::Meta::TypeConstraint>.
+L<Mouse::Meta::TypeConstraint>.
 
 =head1 AUTHOR