1 package Moose::Meta::TypeConstraint::Class;
8 use Scalar::Util 'blessed';
9 use Moose::Util::TypeConstraints ();
11 use base 'Moose::Meta::TypeConstraint';
13 __PACKAGE__->meta->add_attribute('class' => (
22 "Scalar::Util::blessed($val) && $val->isa("
23 . B::perlstring( $self->class ) . ')';
27 my ( $class, %args ) = @_;
30 = Moose::Util::TypeConstraints::find_type_constraint('Object');
32 my $class_name = $args{class};
33 $args{constraint} = sub { $_[0]->isa($class_name) };
35 $args{inlined} = $inliner;
37 my $self = $class->_new( \%args );
39 $self->_create_hand_optimized_type_constraint;
40 $self->compile_type_constraint();
45 sub _create_hand_optimized_type_constraint {
47 my $class = $self->class;
48 $self->hand_optimized_type_constraint(
50 blessed( $_[0] ) && $_[0]->isa($class)
60 # FIXME find_type_constraint might find a TC named after the class but that isn't really it
61 # I did this anyway since it's a convention that preceded TypeConstraint::Class, and it should DWIM
62 # if anybody thinks this problematic please discuss on IRC.
63 # a possible fix is to add by attr indexing to the type registry to find types of a certain property
64 # regardless of their name
65 Moose::Util::TypeConstraints::find_type_constraint($_)
67 __PACKAGE__->new( class => $_, name => "__ANON__" )
68 } Class::MOP::class_of($self->class)->superclasses,
73 my ( $self, $type_or_name ) = @_;
75 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
77 return unless defined $other;
78 return unless $other->isa(__PACKAGE__);
80 return $self->class eq $other->class;
84 my ($self, $type_or_name) = @_;
86 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
88 ($self->equals($type) || $self->is_subtype_of($type_or_name));
92 my ($self, $type_or_name_or_class ) = @_;
94 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_class);
96 if ( not defined $type ) {
97 if ( not ref $type_or_name_or_class ) {
99 return 1 if $self->class->isa( $type_or_name_or_class );
104 if ( $type->isa(__PACKAGE__) && $type->class ne $self->class) {
105 # if $type_or_name_or_class isn't a class, it might be the TC name of another ::Class type
106 # or it could also just be a type object in this branch
107 return $self->class->isa( $type->class );
109 # the only other thing we are a subtype of is Object
110 $self->SUPER::is_subtype_of($type);
114 # This is a bit counter-intuitive, but a child type of a Class type
115 # constraint is not itself a Class type constraint (it has no class
116 # attribute). This whole create_child_type thing needs some changing
117 # though, probably making MMC->new a factory or something.
118 sub create_child_type {
119 my ($self, @args) = @_;
120 return Moose::Meta::TypeConstraint->new(@args, parent => $self);
127 if ($self->has_message) {
128 return $self->SUPER::get_message(@_);
131 $value = (defined $value ? overload::StrVal($value) : 'undef');
132 return "Validation failed for '" . $self->name . "' with value $value (not isa " . $self->class . ")";
137 # ABSTRACT: Class/TypeConstraint parallel hierarchy
145 This class represents type constraints for a class.
149 C<Moose::Meta::TypeConstraint::Class> is a subclass of
150 L<Moose::Meta::TypeConstraint>.
156 =item B<< Moose::Meta::TypeConstraint::Class->new(%options) >>
158 This creates a new class type constraint based on the given
161 It takes the same options as its parent, with two exceptions. First,
162 it requires an additional option, C<class>, which is name of the
163 constraint's class. Second, it automatically sets the parent to the
166 The constructor also overrides the hand optimized type constraint with
167 one it creates internally.
169 =item B<< $constraint->class >>
171 Returns the class name associated with the constraint.
173 =item B<< $constraint->parents >>
175 Returns all the type's parent types, corresponding to its parent
178 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
180 If the given type is also a class type, then this checks that the
181 type's class is a subclass of the other type's class.
183 Otherwise it falls back to the implementation in
184 L<Moose::Meta::TypeConstraint>.
186 =item B<< $constraint->create_child_type(%options) >>
188 This returns a new L<Moose::Meta::TypeConstraint> object with the type
191 Note that it does I<not> return a
192 C<Moose::Meta::TypeConstraint::Class> object!
194 =item B<< $constraint->get_message($value) >>
196 This is the same as L<Moose::Meta::TypeConstraint/get_message> except
197 that it explicitly says C<isa> was checked. This is to help users deal
198 with accidentally autovivified type constraints.
204 See L<Moose/BUGS> for details on reporting bugs.