X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FMeta%2FTypeConstraint%2FAutocoerce.pm;h=f335cb95f108fd787c4a82a5efba913713f43bdf;hb=f54cadb836315572aa2c4bcb16f221da1687df7a;hp=cdbc69c083c71a60cd759e7019a45bba4e137e45;hpb=4822c0bbb4054d2e5068c0e9592c3965ee9d87f3;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 cdbc69c..f335cb9 100644
--- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
+++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
@@ -9,11 +9,81 @@ 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
+
+    # The target class of the autocoercion (cannot be changed)
+    {
+     package X;
+     use Any::Moose;
+     has 'id' => (
+      is  => 'ro',
+      isa => 'Int',
+     );
+     use LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
+     use Any::Moose 'Util::TypeConstraints';
+     register_type_constraint(
+      LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
+       name   => 'X::Autocoerce',
+       parent => find_type_constraint(__PACKAGE__),
+       mapper => sub { join '::', __PACKAGE__, 'From', $_[1] },
+      );
+     );
+     __PACKAGE__->meta->make_immutable;
+    }
+
+    # The class that does the coercion (cannot be changed)
+    {
+     package Y;
+     use Any::Moose;
+     has 'x' => (
+      is      => 'ro',
+      isa     => 'X::Autocoerce',
+      coerce  => 1,
+      handles => [ 'id' ],
+     );
+     __PACKAGE__->meta->make_immutable;
+    }
+
+    # Another class the user wants to use instead of X (cannot be changed)
+    {
+     package Z;
+     use Any::Moose;
+     has 'id' => (
+      is  => 'ro',
+      isa => 'Num',
+     );
+     __PACKAGE__->meta->make_immutable;
+    }
+
+    # The autocoercion class, defined by the user in X/From/Z.pm
+    {
+     package X::From::Z;
+     use Any::Moose 'Util::TypeConstraints';
+     coerce 'X::Autocoerce'
+         => from 'Z'
+         => via { X->new(id => int $_->id) };
+    }
+
+    my $z = Z->new(id => 123);
+    my $y = Y->new(x => $z);
+    print $y->id; # 123
+
+=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.
+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>.
+
+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>.
+
+=cut
 
 use Scalar::Util qw/blessed/;
 
@@ -22,10 +92,23 @@ use Sub::Name ();
 use Any::Moose;
 use Any::Moose 'Util' => [ 'find_meta' ];
 
+=head1 RELATIONSHIPS
+
+This class inherits from L<Moose::Meta::TypeConstraint> or L<Mouse::Meta::TypeConstraint>, depending on which mode L<Any::Moose> runs.
+
+=cut
+
 extends any_moose('Meta::TypeConstraint');
 
 =head1 ATTRIBUTES
 
+=head2 C<name>
+
+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.
+
 =head2 C<mapper>
 
 A code reference that maps an object class name to the name of the package in which the coercion can be found, or C<undef> to disable coercion for this class name.
@@ -34,12 +117,17 @@ It is called with the type constraint object as first argument, followed by the
 =cut
 
 has 'mapper' => (
- is  => 'ro',
- isa => 'CodeRef',
+ is       => 'ro',
+ isa      => 'CodeRef',
+ required => 1,
 );
 
 =head2 C<parent>
 
+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>.
+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' => (
@@ -50,16 +138,21 @@ has 'parent' => (
 
 =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]',
- required => 1,
+ is  => 'ro',
+ isa => 'Maybe[CodeRef]',
 );
 
 =head1 METHODS
 
+=head2 C<< new name => $name, mapper => $mapper, parent => $parent, [ 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>.
+
 =cut
 
 around 'new' => sub {
@@ -70,15 +163,15 @@ around 'new' => sub {
  }
 
  my $parent = delete $args{parent};
- unless (blessed $parent) {
-  $parent = find_meta($parent)->type_constraint;
+ unless (defined $parent and blessed $parent) {
+  $parent = find_meta($parent);
+  Carp::confess("No meta object for parent $parent");
+  $parent = $parent->type_constraint;
  }
  __PACKAGE__->meta->find_attribute_by_name('parent')
                   ->type_constraint->assert_valid($parent);
  $args{parent} = $parent;
 
- $args{user_constraint} = delete $args{constraint};
-
  if (any_moose() eq 'Moose') {
   $args{coercion} = Moose::Meta::TypeCoercion->new;
  }
@@ -105,6 +198,12 @@ around 'new' => sub {
  $tc = $class->$orig(%args);
 };
 
+=head2 C<coerce $thing>
+
+Tries to coerce C<$thing> by first loading a class that might contain a type coercion for it.
+
+=cut
+
 around 'coerce' => sub {
  my ($orig, $tc, $thing) = @_;
 
@@ -146,6 +245,10 @@ __PACKAGE__->meta->make_immutable(
  inline_constructor => 0,
 );
 
+=head1 SEE ALSO
+
+L<Moose::Meta::TypeConstraint>, L<Mouse::Meta::TypeConstraint>.
+
 =head1 AUTHOR
 
 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.