1 package LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
8 LaTeX::TikZ::Meta::TypeConstraint::Autocoerce - Type constraint metaclass that autoloads type coercions.
16 our $VERSION = '0.01';
22 extends any_moose('Meta::TypeConstraint');
39 has 'parent_name' => (
45 =head2 C<user_constraint>
49 has 'user_constraint' => (
51 isa => 'Maybe[CodeRef]',
60 my ($orig, $class, %args) = @_;
62 unless (exists $args{mapper}) {
63 $args{mapper} = sub { join '::', $_[0]->parent_name, $_[1] };
66 my $parent = delete $args{parent};
67 $args{parent_name} = defined $parent
68 ? (blessed($parent) ? $parent->name : $parent)
71 $args{user_constraint} = $args{constraint};
73 if (any_moose() eq 'Moose') {
74 $args{coercion} = Moose::Meta::TypeCoercion->new;
77 my $parent_name = $args{parent_name};
78 $parent_name =~ s/::+/_/g;
81 $args{constraint} = Sub::Name::subname('_load' => sub {
85 $tc = $class->$orig(%args);
93 my ($tc, $thing) = @_;
95 # First, try a possible user defined constraint
96 my $user = $tc->user_constraint;
98 my $ok = $user->($thing);
102 # When ->check is called inside coerce, a return value of 0 means that
103 # coercion should take place, while 1 signifies that the value is already
106 my $class = blessed($thing);
107 return 0 unless $class;
108 return 1 if $class->isa($tc->parent_name);
110 my $mapper = $tc->mapper;
111 my $pm = $class = $tc->$mapper($class);
115 return 0 if $INC{$pm}; # already loaded
118 eval { require $pm; 1 };
123 around 'coerce' => sub {
124 my ($orig, $tc, $thing) = @_;
126 # The original coerce gets an hold onto the type coercions *before* calling
127 # the constraint. Thus, we have to force the loading before recalling into
128 # $orig. This is achieved by calling ->load.
129 return $thing if $tc->load($thing);
134 __PACKAGE__->meta->make_immutable(
135 inline_constructor => 0,
140 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
142 You can contact me by mail or on C<irc.perl.org> (vincent).
146 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>.
147 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
151 You can find documentation for this module with the perldoc command.
155 =head1 COPYRIGHT & LICENSE
157 Copyright 2010 Vincent Pit, all rights reserved.
159 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
163 1; # End of LaTeX::TikZ::Meta::TypeConstraint::Autocoerce