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';
18 use Scalar::Util qw/blessed/;
23 use Any::Moose 'Util' => [ 'find_meta' ];
25 extends any_moose('Meta::TypeConstraint');
44 isa => any_moose('Meta::TypeConstraint'),
48 =head2 C<user_constraint>
52 has 'user_constraint' => (
54 isa => 'Maybe[CodeRef]',
63 my ($orig, $class, %args) = @_;
65 unless (exists $args{mapper}) {
66 $args{mapper} = sub { join '::', $_[0]->parent->name, $_[1] };
69 my $parent = delete $args{parent};
70 unless (blessed $parent) {
71 $parent = find_meta($parent)->type_constraint;
73 __PACKAGE__->meta->find_attribute_by_name('parent')
74 ->type_constraint->assert_valid($parent);
75 $args{parent} = $parent;
77 $args{user_constraint} = delete $args{constraint};
79 if (any_moose() eq 'Moose') {
80 $args{coercion} = Moose::Meta::TypeCoercion->new;
84 $args{constraint} = Sub::Name::subname('_load' => sub {
88 $tc = $class->$orig(%args);
96 my ($tc, $thing) = @_;
98 # When ->check is called inside coerce, a return value of 0 means that
99 # coercion should take place, while 1 signifies that the value is already
102 # First, try a possible user defined constraint
103 my $user = $tc->user_constraint;
105 my $ok = $user->($thing);
109 # Then, try the parent constraint
110 return 1 if $tc->parent->check($thing);
112 # If $thing isn't even an object, don't bother trying to coerce it
113 my $class = blessed($thing);
114 return 0 unless defined $class;
116 # Find the file to autoload
117 my $mapper = $tc->mapper;
118 my $pm = $class = $tc->$mapper($class);
121 return 0 if $INC{$pm}; # already loaded
125 # We die often here, even though we're not really interested in the error.
126 # However, if a die handler is set (e.g. to \&Carp::confess), this can get
127 # very slow. Resetting the handler shows a 10% total time improvement for the
136 around 'coerce' => sub {
137 my ($orig, $tc, $thing) = @_;
139 # The original coerce gets an hold onto the type coercions *before* calling
140 # the constraint. Thus, we have to force the loading before recalling into
141 # $orig. This is achieved by calling ->load.
142 return $thing if $tc->load($thing);
147 __PACKAGE__->meta->make_immutable(
148 inline_constructor => 0,
153 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
155 You can contact me by mail or on C<irc.perl.org> (vincent).
159 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>.
160 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
164 You can find documentation for this module with the perldoc command.
168 =head1 COPYRIGHT & LICENSE
170 Copyright 2010 Vincent Pit, all rights reserved.
172 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
176 1; # End of LaTeX::TikZ::Meta::TypeConstraint::Autocoerce