Commit | Line | Data |
3fef8ce8 |
1 | package Moose::Meta::TypeConstraint::Class; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use metaclass; |
6 | |
28412c0b |
7 | use Scalar::Util 'blessed'; |
8 | use Moose::Util::TypeConstraints (); |
3fef8ce8 |
9 | |
28412c0b |
10 | our $VERSION = '0.01'; |
11 | our $AUTHORITY = 'cpan:STEVAN'; |
3fef8ce8 |
12 | |
28412c0b |
13 | use base 'Moose::Meta::TypeConstraint'; |
3fef8ce8 |
14 | |
15 | sub new { |
16 | my $class = shift; |
28412c0b |
17 | my $self = $class->meta->new_object(@_, |
18 | parent => Moose::Util::TypeConstraints::find_type_constraint('Object') |
19 | ); |
3fef8ce8 |
20 | $self->compile_type_constraint() |
21 | unless $self->_has_compiled_type_constraint; |
22 | return $self; |
23 | } |
24 | |
25 | sub parents { |
26 | my $self = shift; |
27 | return ( |
28 | $self->parent, |
28412c0b |
29 | map { |
30 | # NOTE: |
31 | # Hmm, should this be find_or_create_type_constraint? |
32 | # What do you think nothingmuch?? |
33 | # - SL |
34 | Moose::Util::TypeConstraints::find_type_constraint($_) |
35 | } $self->name->meta->superclasses, |
3fef8ce8 |
36 | ); |
37 | } |
38 | |
39 | sub hand_optimized_type_constraint { |
28412c0b |
40 | my $self = shift; |
3fef8ce8 |
41 | my $class = $self->name; |
fd542f49 |
42 | sub { blessed( $_[0] ) && $_[0]->isa($class) } |
3fef8ce8 |
43 | } |
44 | |
45 | sub has_hand_optimized_type_constraint { 1 } |
46 | |
47 | sub is_a_type_of { |
48 | my ($self, $type_name) = @_; |
49 | |
50 | return $self->name eq $type_name || $self->is_subtype_of($type_name); |
51 | } |
52 | |
53 | sub is_subtype_of { |
54 | my ($self, $type_name) = @_; |
55 | |
56 | return 1 if $type_name eq 'Object'; |
57 | return $self->name->isa( $type_name ); |
58 | } |
59 | |
60 | 1; |
61 | |
62 | __END__ |
28412c0b |
63 | |
3fef8ce8 |
64 | =pod |
65 | |
66 | =head1 NAME |
67 | |
68 | Moose::Meta::TypeConstraint::Class - Class/TypeConstraint parallel hierarchy |
69 | |
70 | =head1 METHODS |
71 | |
72 | =over 4 |
73 | |
28412c0b |
74 | =item B<new> |
3fef8ce8 |
75 | |
28412c0b |
76 | =item B<hand_optimized_type_constraint> |
3fef8ce8 |
77 | |
28412c0b |
78 | =item B<has_hand_optimized_type_constraint> |
3fef8ce8 |
79 | |
28412c0b |
80 | =item B<is_a_type_of> |
3fef8ce8 |
81 | |
28412c0b |
82 | =item B<is_subtype_of> |
3fef8ce8 |
83 | |
28412c0b |
84 | =item B<parents> |
3fef8ce8 |
85 | |
86 | Return all the parent types, corresponding to the parent classes. |
87 | |
28412c0b |
88 | =item B<meta> |
89 | |
3fef8ce8 |
90 | =back |
91 | |
28412c0b |
92 | =head1 BUGS |
93 | |
94 | All complex software has bugs lurking in it, and this module is no |
95 | exception. If you find a bug please either email me, or add the bug |
96 | to cpan-RT. |
97 | |
98 | =head1 AUTHOR |
99 | |
100 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> |
101 | |
102 | =head1 COPYRIGHT AND LICENSE |
103 | |
104 | Copyright 2006-2008 by Infinity Interactive, Inc. |
105 | |
106 | L<http://www.iinteractive.com> |
107 | |
108 | This library is free software; you can redistribute it and/or modify |
109 | it under the same terms as Perl itself. |
110 | |
3fef8ce8 |
111 | =cut |