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' => (
15 Class::MOP::_definition_context(),
22 return 'Scalar::Util::blessed(' . $val . ')'
23 . ' && ' . $val . '->isa(' . 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->SUPER::new( \%args );
39 $self->compile_type_constraint();
49 # FIXME find_type_constraint might find a TC named after the class but that isn't really it
50 # I did this anyway since it's a convention that preceded TypeConstraint::Class, and it should DWIM
51 # if anybody thinks this problematic please discuss on IRC.
52 # a possible fix is to add by attr indexing to the type registry to find types of a certain property
53 # regardless of their name
54 Moose::Util::TypeConstraints::find_type_constraint($_)
56 __PACKAGE__->new( class => $_, name => "__ANON__" )
57 } Class::MOP::class_of($self->class)->superclasses,
62 my ( $self, $type_or_name ) = @_;
64 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
66 return unless defined $other;
67 return unless $other->isa(__PACKAGE__);
69 return $self->class eq $other->class;
73 my ($self, $type_or_name) = @_;
75 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
77 ($self->equals($type) || $self->is_subtype_of($type_or_name));
81 my ($self, $type_or_name_or_class ) = @_;
83 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_class);
85 if ( not defined $type ) {
86 if ( not ref $type_or_name_or_class ) {
88 return 1 if $self->class->isa( $type_or_name_or_class );
93 if ( $type->isa(__PACKAGE__) && $type->class ne $self->class) {
94 # if $type_or_name_or_class isn't a class, it might be the TC name of another ::Class type
95 # or it could also just be a type object in this branch
96 return $self->class->isa( $type->class );
98 # the only other thing we are a subtype of is Object
99 $self->SUPER::is_subtype_of($type);
103 # This is a bit counter-intuitive, but a child type of a Class type
104 # constraint is not itself a Class type constraint (it has no class
105 # attribute). This whole create_child_type thing needs some changing
106 # though, probably making MMC->new a factory or something.
107 sub create_child_type {
108 my ($self, @args) = @_;
109 return Moose::Meta::TypeConstraint->new(@args, parent => $self);
116 if ($self->has_message) {
117 return $self->SUPER::get_message(@_);
120 $value = (defined $value ? overload::StrVal($value) : 'undef');
121 return "Validation failed for '" . $self->name . "' with value $value (not isa " . $self->class . ")";
126 # ABSTRACT: Class/TypeConstraint parallel hierarchy
134 This class represents type constraints for a class.
138 C<Moose::Meta::TypeConstraint::Class> is a subclass of
139 L<Moose::Meta::TypeConstraint>.
145 =item B<< Moose::Meta::TypeConstraint::Class->new(%options) >>
147 This creates a new class type constraint based on the given
150 It takes the same options as its parent, with two exceptions. First,
151 it requires an additional option, C<class>, which is name of the
152 constraint's class. Second, it automatically sets the parent to the
155 The constructor also overrides the hand optimized type constraint with
156 one it creates internally.
158 =item B<< $constraint->class >>
160 Returns the class name associated with the constraint.
162 =item B<< $constraint->parents >>
164 Returns all the type's parent types, corresponding to its parent
167 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
169 If the given type is also a class type, then this checks that the
170 type's class is a subclass of the other type's class.
172 Otherwise it falls back to the implementation in
173 L<Moose::Meta::TypeConstraint>.
175 =item B<< $constraint->create_child_type(%options) >>
177 This returns a new L<Moose::Meta::TypeConstraint> object with the type
180 Note that it does I<not> return a
181 C<Moose::Meta::TypeConstraint::Class> object!
183 =item B<< $constraint->get_message($value) >>
185 This is the same as L<Moose::Meta::TypeConstraint/get_message> except
186 that it explicitly says C<isa> was checked. This is to help users deal
187 with accidentally autovivified type constraints.
193 See L<Moose/BUGS> for details on reporting bugs.