1 package LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
8 LaTeX::TikZ::Meta::TypeConstraint::Autocoerce - Type constraint metaclass that autoloads type coercions.
16 our $VERSION = '0.02';
20 # The target class of the autocoercion (cannot be changed)
28 use LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
29 use Any::Moose 'Util::TypeConstraints';
30 register_type_constraint(
31 LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
32 name => 'X::Autocoerce',
33 target => find_type_constraint(__PACKAGE__),
34 mapper => sub { join '::', __PACKAGE__, 'From', $_[1] },
37 __PACKAGE__->meta->make_immutable;
40 # The class that does the coercion (cannot be changed)
46 isa => 'X::Autocoerce',
50 __PACKAGE__->meta->make_immutable;
53 # Another class the user wants to use instead of X (cannot be changed)
61 __PACKAGE__->meta->make_immutable;
64 # The autocoercion class, defined by the user in X/From/Z.pm
67 use Any::Moose 'Util::TypeConstraints';
68 coerce 'X::Autocoerce'
70 => via { X->new(id => int $_->id) };
73 my $z = Z->new(id => 123);
74 my $y = Y->new(x => $z);
79 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.
80 This allows you to declare types that can be replaced (through coercion) at the end user's discretion.
82 It works with both L<Moose> and L<Mouse> by using L<Any::Moose>.
84 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>.
88 use Scalar::Util qw<blessed>;
92 use LaTeX::TikZ::Tools;
98 This class inherits from L<Moose::Meta::TypeConstraint> or L<Mouse::Meta::TypeConstraint>, depending on which mode L<Any::Moose> runs.
102 extends any_moose('Meta::TypeConstraint');
108 The name of the type constraint.
109 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.
111 This attribute is inherited from the L<Moose> or L<Mouse> type constraint metaclass.
115 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.
116 It is called with the type constraint object as first argument, followed by the class name.
128 A type constraint that defines into what the objects are going to be coerced.
129 Objects satisfying this type constraint will be automatically considered as valid and will not be coerced.
130 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.
136 isa => any_moose('Meta::TypeConstraint'),
140 =head2 C<user_constraint>
142 An optional user defined code reference which predates checking the target for validity.
146 has 'user_constraint' => (
148 isa => 'Maybe[CodeRef]',
153 =head2 C<< new name => $name, mapper => $mapper, target => $target, [ user_constraint => sub { ... } ] >>
155 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>.
159 around 'new' => sub {
160 my ($orig, $class, %args) = @_;
162 unless (exists $args{mapper}) {
163 $args{mapper} = sub { join '::', $_[0]->target->name, $_[1] };
166 my $target = delete $args{target};
167 unless (blessed $target) {
168 my $target_name = defined $target ? "target $target" : 'undefined target';
169 $target = LaTeX::TikZ::Tools::type_constraint($target) if defined $target;
170 Carp::confess("No meta object for $target_name") unless defined $target;
172 __PACKAGE__->meta->find_attribute_by_name('target')
173 ->type_constraint->assert_valid($target);
174 $args{target} = $target;
176 if (any_moose() eq 'Moose') {
177 $args{coercion} = Moose::Meta::TypeCoercion->new;
181 $args{constraint} = Sub::Name::subname('_constraint' => sub {
184 # Remember that when ->check is called inside coerce, a return value of 0
185 # means that coercion should take place, while 1 signifies that the value is
188 # First, try a possible user defined constraint
189 my $user = $tc->user_constraint;
191 my $ok = $user->($thing);
195 # Then, it's valid if and only if it passes the target type constraint
196 return $tc->target->check($thing);
199 $tc = $class->$orig(%args);
202 =head2 C<coerce $thing>
204 Tries to coerce C<$thing> by first loading a class that might contain a type coercion for it.
208 around 'coerce' => sub {
209 my ($orig, $tc, $thing) = @_;
211 # The original coerce gets an hold onto the type coercions *before* calling
212 # the constraint. Thus, we have to force the loading before recalling into
215 # First, check whether $thing is already of the right kind.
216 return $thing if $tc->check($thing);
218 # If $thing isn't even an object, don't bother trying to autoload a coercion
219 my $class = blessed($thing);
220 if (defined $class) {
221 $class = $tc->mapper->($tc, $class);
223 if (defined $class) {
224 # Find the file to autoload
225 (my $pm = $class) =~ s{::}{/}g;
228 unless ($INC{$pm}) { # Not loaded yet
231 # We die often here, even though we're not really interested in the error.
232 # However, if a die handler is set (e.g. to \&Carp::confess), this can get
233 # very slow. Resetting the handler shows a 10% total time improvement for
245 __PACKAGE__->meta->make_immutable(
246 inline_constructor => 0,
251 L<Moose::Meta::TypeConstraint>, L<Mouse::Meta::TypeConstraint>.
255 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
257 You can contact me by mail or on C<irc.perl.org> (vincent).
261 Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
262 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
266 You can find documentation for this module with the perldoc command.
270 =head1 COPYRIGHT & LICENSE
272 Copyright 2010 Vincent Pit, all rights reserved.
274 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
278 1; # End of LaTeX::TikZ::Meta::TypeConstraint::Autocoerce