X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FMeta%2FTypeConstraint%2FAutocoerce.pm;h=00fbbf4a547ac485aa787a15defb9fdc92d651d2;hb=c3b268a795d0378bc3b2a73f8755af80df78b542;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..00fbbf4 100644 --- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm +++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm @@ -9,23 +9,107 @@ 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', + target => 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 + +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 and L by using L. + +Note that you will need L or L to install this type constraint, and that the latter is only available starting L C<0.63>. -use Scalar::Util qw/blessed/; +=cut + +use Scalar::Util qw; use Sub::Name (); +use LaTeX::TikZ::Tools; + use Any::Moose; -use Any::Moose 'Util' => [ 'find_meta' ]; + +=head1 RELATIONSHIPS + +This class inherits from L or L, depending on which mode L runs. + +=cut extends any_moose('Meta::TypeConstraint'); =head1 ATTRIBUTES +=head2 C + +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 or L type constraint metaclass. + =head2 C A code reference that maps an object class name to the name of the package in which the coercion can be found, or C to disable coercion for this class name. @@ -34,50 +118,62 @@ 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 +=head2 C + +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 +An optional user defined code reference which predates checking the target 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, target => $target, [ user_constraint => sub { ... } ] >> + +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 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 (blessed $parent) { - $parent = find_meta($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; - - $args{user_constraint} = delete $args{constraint}; + $target_tc->assert_valid($target); + $args{target} = $target; if (any_moose() eq 'Moose') { $args{coercion} = Moose::Meta::TypeCoercion->new; @@ -98,13 +194,19 @@ 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); }; +=head2 C + +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 +248,10 @@ __PACKAGE__->meta->make_immutable( inline_constructor => 0, ); +=head1 SEE ALSO + +L, L. + =head1 AUTHOR Vincent Pit, C<< >>, L.