X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FRole.pm;h=b8e375a2235cd87424d80f669a850833e8e62c1a;hb=883e299ed6375fe5c9d8df203f68bcc0f57d0641;hp=c37482d53bdc039a1351d2d729c2e1364147f8fd;hpb=b2ad68e3fbe4016e354980a636c1ed39e941162a;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Role.pm b/lib/Moose/Meta/TypeConstraint/Role.pm index c37482d..b8e375a 100644 --- a/lib/Moose/Meta/TypeConstraint/Role.pm +++ b/lib/Moose/Meta/TypeConstraint/Role.pm @@ -7,10 +7,6 @@ use metaclass; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints (); -our $VERSION = '0.67'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('role' => ( @@ -20,7 +16,7 @@ __PACKAGE__->meta->add_attribute('role' => ( sub new { my ( $class, %args ) = @_; - $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Role'); + $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object'); my $self = $class->_new(\%args); $self->_create_hand_optimized_type_constraint; @@ -47,10 +43,10 @@ sub parents { # if anybody thinks this problematic please discuss on IRC. # a possible fix is to add by attr indexing to the type registry to find types of a certain property # regardless of their name - Moose::Util::TypeConstraints::find_type_constraint($_) - || + Moose::Util::TypeConstraints::find_type_constraint($_) + || __PACKAGE__->new( role => $_, name => "__ANON__" ) - } @{ $self->role->meta->get_roles }, + } @{ Class::MOP::class_of($self->role)->get_roles }, ); } @@ -78,17 +74,17 @@ sub is_subtype_of { if ( not ref $type_or_name_or_role ) { # it might be a role - return 1 if $self->role->meta->does_role( $type_or_name_or_role ); + return 1 if Class::MOP::class_of($self->role)->does_role( $type_or_name_or_role ); } my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_role); return unless defined $type; - + if ( $type->isa(__PACKAGE__) ) { # if $type_or_name_or_role isn't a role, it might be the TC name of another ::Role type # or it could also just be a type object in this branch - return $self->role->meta->does_role( $type->role ); + return Class::MOP::class_of($self->role)->does_role( $type->role ); } else { # the only other thing we are a subtype of is Object $self->SUPER::is_subtype_of($type); @@ -102,59 +98,67 @@ sub create_child_type { 1; +# ABSTRACT: Role/TypeConstraint parallel hierarchy + __END__ =pod -=head1 NAME +=head1 DESCRIPTION -Moose::Meta::TypeConstraint::Role - Role/TypeConstraint parallel hierarchy +This class represents type constraints for a role. -=head1 METHODS - -=over 4 +=head1 INHERITANCE -=item B +C is a subclass of +L. -=item B +=head1 METHODS -=item B +=over 4 -=item B +=item B<< Moose::Meta::TypeConstraint::Role->new(%options) >> -=item B +This creates a new role type constraint based on the given +C<%options>. -=item B +It takes the same options as its parent, with two exceptions. First, +it requires an additional option, C, which is name of the +constraint's role. Second, it automatically sets the parent to the +C type. -=item B +The constructor also overrides the hand optimized type constraint with +one it creates internally. -=item B +=item B<< $constraint->role >> -=item B +Returns the role name associated with the constraint. -Return all the parent types, corresponding to the parent classes. +=item B<< $constraint->parents >> -=item B +Returns all the type's parent types, corresponding to the roles that +its role does. -=back +=item B<< $constraint->is_subtype_of($type_name_or_object) >> -=head1 BUGS +If the given type is also a role type, then this checks that the +type's role does the other type's role. -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +Otherwise it falls back to the implementation in +L. -=head1 AUTHOR +=item B<< $constraint->create_child_type(%options) >> -Yuval Kogman Enothingmuch@cpan.orgE +This returns a new L object with the type +as its parent. -=head1 COPYRIGHT AND LICENSE +Note that it does I return a C +object! -Copyright 2006-2009 by Infinity Interactive, Inc. +=back -L +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut