1 package Moose::Meta::TypeConstraint::Role;
8 use Scalar::Util 'blessed';
9 use Moose::Util::TypeConstraints ();
11 use base 'Moose::Meta::TypeConstraint';
13 __PACKAGE__->meta->add_attribute('role' => (
15 Class::MOP::_definition_context(),
22 return 'Moose::Util::does_role('
24 . B::perlstring($self->role)
29 my ( $class, %args ) = @_;
31 $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object');
33 my $role_name = $args{role};
34 $args{constraint} = sub { Moose::Util::does_role( $_[0], $role_name ) };
36 $args{inlined} = $inliner;
38 my $self = $class->SUPER::new( \%args );
40 $self->_create_hand_optimized_type_constraint;
41 $self->compile_type_constraint();
46 sub _create_hand_optimized_type_constraint {
48 my $role = $self->role;
49 $self->hand_optimized_type_constraint(
50 sub { Moose::Util::does_role($_[0], $role) }
59 # FIXME find_type_constraint might find a TC named after the role but that isn't really it
60 # I did this anyway since it's a convention that preceded TypeConstraint::Role, and it should DWIM
61 # if anybody thinks this problematic please discuss on IRC.
62 # a possible fix is to add by attr indexing to the type registry to find types of a certain property
63 # regardless of their name
64 Moose::Util::TypeConstraints::find_type_constraint($_)
66 __PACKAGE__->new( role => $_, name => "__ANON__" )
67 } @{ Class::MOP::class_of($self->role)->get_roles },
72 my ( $self, $type_or_name ) = @_;
74 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
76 return unless defined $other;
77 return unless $other->isa(__PACKAGE__);
79 return $self->role eq $other->role;
83 my ($self, $type_or_name) = @_;
85 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
87 ($self->equals($type) || $self->is_subtype_of($type_or_name));
91 my ($self, $type_or_name_or_role ) = @_;
93 if ( not ref $type_or_name_or_role ) {
95 my $class = Class::MOP::class_of($self->role);
96 return 1 if defined($class) && $class->does_role( $type_or_name_or_role );
99 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_role);
101 return unless defined $type;
103 if ( $type->isa(__PACKAGE__) ) {
104 # if $type_or_name_or_role isn't a role, it might be the TC name of another ::Role type
105 # or it could also just be a type object in this branch
106 my $class = Class::MOP::class_of($self->role);
107 return defined($class) && $class->does_role( $type->role );
109 # the only other thing we are a subtype of is Object
110 $self->SUPER::is_subtype_of($type);
114 sub create_child_type {
115 my ($self, @args) = @_;
116 return Moose::Meta::TypeConstraint->new(@args, parent => $self);
121 # ABSTRACT: Role/TypeConstraint parallel hierarchy
129 This class represents type constraints for a role.
133 C<Moose::Meta::TypeConstraint::Role> is a subclass of
134 L<Moose::Meta::TypeConstraint>.
140 =item B<< Moose::Meta::TypeConstraint::Role->new(%options) >>
142 This creates a new role type constraint based on the given
145 It takes the same options as its parent, with two exceptions. First,
146 it requires an additional option, C<role>, which is name of the
147 constraint's role. Second, it automatically sets the parent to the
150 The constructor also overrides the hand optimized type constraint with
151 one it creates internally.
153 =item B<< $constraint->role >>
155 Returns the role name associated with the constraint.
157 =item B<< $constraint->parents >>
159 Returns all the type's parent types, corresponding to the roles that
162 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
164 If the given type is also a role type, then this checks that the
165 type's role does the other type's role.
167 Otherwise it falls back to the implementation in
168 L<Moose::Meta::TypeConstraint>.
170 =item B<< $constraint->create_child_type(%options) >>
172 This returns a new L<Moose::Meta::TypeConstraint> object with the type
175 Note that it does I<not> return a C<Moose::Meta::TypeConstraint::Role>
182 See L<Moose/BUGS> for details on reporting bugs.