1 package Moose::Meta::TypeConstraint::Role;
7 use Scalar::Util 'blessed';
8 use Moose::Util::TypeConstraints ();
10 our $VERSION = '0.60';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Moose::Meta::TypeConstraint';
16 __PACKAGE__->meta->add_attribute('role' => (
21 my ( $class, %args ) = @_;
23 $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Role');
24 my $self = $class->_new(\%args);
26 $self->_create_hand_optimized_type_constraint;
27 $self->compile_type_constraint();
32 sub _create_hand_optimized_type_constraint {
34 my $role = $self->role;
35 $self->hand_optimized_type_constraint(
36 sub { Moose::Util::does_role($_[0], $role) }
45 # FIXME find_type_constraint might find a TC named after the role but that isn't really it
46 # I did this anyway since it's a convention that preceded TypeConstraint::Role, and it should DWIM
47 # if anybody thinks this problematic please discuss on IRC.
48 # a possible fix is to add by attr indexing to the type registry to find types of a certain property
49 # regardless of their name
50 Moose::Util::TypeConstraints::find_type_constraint($_)
52 __PACKAGE__->new( role => $_, name => "__ANON__" )
53 } @{ $self->role->meta->get_roles },
58 my ( $self, $type_or_name ) = @_;
60 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
62 return unless defined $other;
63 return unless $other->isa(__PACKAGE__);
65 return $self->role eq $other->role;
69 my ($self, $type_or_name) = @_;
71 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
73 ($self->equals($type) || $self->is_subtype_of($type_or_name));
77 my ($self, $type_or_name_or_role ) = @_;
79 if ( not ref $type_or_name_or_role ) {
81 return 1 if $self->role->meta->does_role( $type_or_name_or_role );
84 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_role);
86 return unless defined $type;
88 if ( $type->isa(__PACKAGE__) ) {
89 # if $type_or_name_or_role isn't a role, it might be the TC name of another ::Role type
90 # or it could also just be a type object in this branch
91 return $self->role->meta->does_role( $type->role );
93 # the only other thing we are a subtype of is Object
94 $self->SUPER::is_subtype_of($type);
106 Moose::Meta::TypeConstraint::Role - Role/TypeConstraint parallel hierarchy
116 =item B<hand_optimized_type_constraint>
118 =item B<has_hand_optimized_type_constraint>
122 =item B<is_a_type_of>
124 =item B<is_subtype_of>
128 Return all the parent types, corresponding to the parent classes.
136 All complex software has bugs lurking in it, and this module is no
137 exception. If you find a bug please either email me, or add the bug
142 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
144 =head1 COPYRIGHT AND LICENSE
146 Copyright 2006-2008 by Infinity Interactive, Inc.
148 L<http://www.iinteractive.com>
150 This library is free software; you can redistribute it and/or modify
151 it under the same terms as Perl itself.