X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FRole.pm;h=09cd625042439b71c1143bdb3a6b2d872f9212ed;hb=2fb4885ef74bc342a049b54d8b89a2eb40685248;hp=c2bf664908c4887580b4dfdcf11ca6548ea0b362;hpb=620db0454d31341c981eb9061132d4f3a08a7310;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Role.pm b/lib/Moose/Meta/TypeConstraint/Role.pm index c2bf664..09cd625 100644 --- a/lib/Moose/Meta/TypeConstraint/Role.pm +++ b/lib/Moose/Meta/TypeConstraint/Role.pm @@ -7,7 +7,8 @@ use metaclass; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints (); -our $VERSION = '0.02'; +our $VERSION = '0.60'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::TypeConstraint'; @@ -19,8 +20,8 @@ __PACKAGE__->meta->add_attribute('role' => ( sub new { my ( $class, %args ) = @_; - $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object'); - my $self = $class->meta->new_object(%args); + $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Role'); + my $self = $class->_new(\%args); $self->_create_hand_optimized_type_constraint; $self->compile_type_constraint(); @@ -58,6 +59,7 @@ sub equals { my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + return unless defined $other; return unless $other->isa(__PACKAGE__); return $self->role eq $other->role; @@ -76,21 +78,28 @@ sub is_subtype_of { if ( not ref $type_or_name_or_role ) { # it might be a role - return 1 if $self->role->does_role( $type_or_name_or_role ); + return 1 if $self->role->meta->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->does_role( $type->role ); + return $self->role->meta->does_role( $type->role ); } else { # the only other thing we are a subtype of is Object $self->SUPER::is_subtype_of($type); } } +sub create_child_type { + my ($self, @args) = @_; + return Moose::meta::TypeConstraint->new(@args, parent => $self); +} + 1; __END__ @@ -107,7 +116,7 @@ Moose::Meta::TypeConstraint::Role - Role/TypeConstraint parallel hierarchy =item B -=item B +=item B =item B @@ -119,6 +128,8 @@ Moose::Meta::TypeConstraint::Role - Role/TypeConstraint parallel hierarchy =item B +=item B + =item B Return all the parent types, corresponding to the parent classes.