From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 12 Apr 2008 14:53:49 +0000 (+0000)
Subject: add 'class' attr to TypeConstraint::Class
X-Git-Tag: 0_55~237
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=336824faac410afa1740ebbce2096452c2068c3c;p=gitmo%2FMoose.git

add 'class' attr to TypeConstraint::Class
---

diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm
index a14ace5..41cc2c6 100644
--- a/lib/Moose/Meta/TypeConstraint/Class.pm
+++ b/lib/Moose/Meta/TypeConstraint/Class.pm
@@ -12,13 +12,22 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::TypeConstraint';
 
+__PACKAGE__->meta->add_attribute('class' => (
+    reader  => 'class',
+));
+
 sub new {
-    my $class = shift;
-    my $self  = $class->meta->new_object(@_, 
-        parent => Moose::Util::TypeConstraints::find_type_constraint('Object') 
-    );
+    my ( $class, %args ) = @_;
+
+    $args{class} = $args{name} unless exists $args{class};
+
+    $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object');
+
+    my $self  = $class->meta->new_object(%args);
+
     $self->compile_type_constraint()
         unless $self->_has_compiled_type_constraint;
+
     return $self;
 }
 
@@ -26,19 +35,20 @@ sub parents {
     my $self = shift;
     return (
         $self->parent,
-        map { 
-            # NOTE:
-            # Hmm, should this be find_or_create_type_constraint?
-            # What do you think nothingmuch??
-            # - SL
-            Moose::Util::TypeConstraints::find_type_constraint($_) 
-        } $self->name->meta->superclasses,
+        map {
+            # FIXME find_type_constraint might find a TC named after the class but that isn't really it
+            # I did this anyway since it's a convention that preceded TypeConstraint::Class, and it should DWIM
+            # 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($_) || __PACKAGE__->new( name => $_ )
+        } $self->class->meta->superclasses,
     );
 }
 
 sub hand_optimized_type_constraint {
     my $self  = shift;
-    my $class = $self->name;
+    my $class = $self->class;
     sub { blessed( $_[0] ) && $_[0]->isa($class) }
 }