X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FRole.pm;h=d90a6ac55a81d2ffc86ef70b4ee9fbdf1b91a63e;hb=2870fb091b5b844678277347a8c710dd58e005e6;hp=5ae68f75d239c8bf9a2dc588e8a30ebeaebdd08e;hpb=93cc8330c689c1eb92171550e5fabb628a8759a6;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Role.pm b/lib/Moose/Meta/TypeConstraint/Role.pm index 5ae68f7..d90a6ac 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.54'; +our $VERSION = '0.72'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::TypeConstraint'; @@ -20,7 +21,7 @@ sub new { my ( $class, %args ) = @_; $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Role'); - my $self = $class->meta->new_object(%args); + 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; @@ -66,7 +68,7 @@ sub equals { sub is_a_type_of { my ($self, $type_or_name) = @_; - my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); ($self->equals($type) || $self->is_subtype_of($type_or_name)); } @@ -81,6 +83,8 @@ sub is_subtype_of { 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 @@ -91,6 +95,11 @@ sub is_subtype_of { } } +sub create_child_type { + my ($self, @args) = @_; + return Moose::Meta::TypeConstraint->new(@args, parent => $self); +} + 1; __END__ @@ -101,29 +110,56 @@ __END__ Moose::Meta::TypeConstraint::Role - Role/TypeConstraint parallel hierarchy +=head1 DESCRIPTION + +This class represents type constraints for a role. + +=head1 INHERITANCE + +C is a subclass of +L. + =head1 METHODS =over 4 -=item B +=item B<< Moose::Meta::TypeConstraint::Role->new(%options) >> + +This creates a new role type constraint based on the given +C<%options>. + +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. + +The constructor also overrides the hand optimized type constraint with +one it creates internally. + +=item B<< $constraint->role >> -=item B +Returns the role name associated with the constraint. -=item B +=item B<< $constraint->parents >> -=item B +Returns all the type's parent types, corresponding to the roles that +its role does. -=item B +=item B<< $constraint->is_subtype_of($type_name_or_object) >> -=item B +If the given type is also a role type, then this checks that the +type's role does the other type's role. -=item B +Otherwise it falls back to the implementation in +L. -=item B +=item B<< $constraint->create_child_type(%options) >> -Return all the parent types, corresponding to the parent classes. +This returns a new L object with the type +as its parent. -=item B +Note that it does I return a C +object! =back @@ -139,7 +175,7 @@ Yuval Kogman Enothingmuch@cpan.orgE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L