what-a-mess

diff --git a/lib/Moose.pm b/lib/Moose.pm
index d8444b5..6f972bc 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -1,6 +1,4 @@
 
-use lib '/Users/stevan/Projects/CPAN/Class-MOP/Class-MOP/lib';
-
 package Moose;
 
 use strict;
@@ -18,9 +16,10 @@ use Class::MOP;
 
 use Moose::Meta::Class;
 use Moose::Meta::Attribute;
+use Moose::Meta::TypeConstraint;
 
 use Moose::Object;
-use Moose::Util::TypeConstraints ':no_export';
+use Moose::Util::TypeConstraints;
 
 sub import {
        shift;
@@ -32,10 +31,9 @@ sub import {
        Moose::Util::TypeConstraints->import($pkg);
        
        # make a subtype for each Moose class
-    Moose::Util::TypeConstraints::subtype($pkg 
-        => Moose::Util::TypeConstraints::as Object 
-        => Moose::Util::TypeConstraints::where { $_->isa($pkg) }
-       );      
+    subtype $pkg 
+        => as Object 
+        => where { $_->isa($pkg) };    
 
        my $meta;
        if ($pkg->can('meta')) {
@@ -79,28 +77,26 @@ sub import {
                if (exists $options{isa}) {
                    # allow for anon-subtypes here ...
                    if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
-                               $options{type_constraint} = $options{isa};
+                               $options{type_constraint} = Moose::Meta::TypeConstraint->new(
+                                   name            => '__ANON__',
+                                   constraint_code => $options{isa}
+                               );
                        }
                        else {
                            # otherwise assume it is a constraint
-                           my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa})->constraint_code;
+                           my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
                            # if the constraing it not found ....
                            unless (defined $constraint) {
                                # assume it is a foreign class, and make 
                                # an anon constraint for it 
-                               $constraint = Moose::Util::TypeConstraints::subtype(
-                                   Object => Moose::Util::TypeConstraints::where { $_->isa($constraint) }
-                       );
-                           }
+                               $constraint = Moose::Meta::TypeConstraint->new(
+                                   name            => '__ANON__',
+                                   constraint_code => subtype Object => where { $_->isa($constraint) }
+                               );
+                           }                       
                 $options{type_constraint} = $constraint;
                        }
                }
-               if (exists $options{coerce} && $options{coerce} && $options{isa}) {
-                   my $coercion = Moose::Util::TypeConstraints::find_type_coercion($options{isa});
-                   (defined $coercion)
-                       || confess "Cannot find coercion for type " . $options{isa};
-                   $options{coerce} = $coercion;
-               }
                $meta->add_attribute($name, %options) 
        });
 

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 332af9e..5d6213b 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -16,7 +16,9 @@ use base 'Class::MOP::Attribute';
 Moose::Meta::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('coerce' => (
         reader    => 'coerce',
-        predicate => 'has_coercion'
+        predicate => {
+                       'has_coercion' => sub { $_[0]->coerce() ? 1 : 0 }
+               }
     )) 
 );
 
@@ -43,10 +45,7 @@ Moose::Meta::Attribute->meta->add_before_method_modifier('new' => sub {
                || confess "You cannot have coercion without specifying a type constraint";
         confess "You cannot have a weak reference to a coerced value"
             if $options{weak_ref};             
-       }
-       (reftype($options{type_constraint}) && reftype($options{type_constraint}) eq 'CODE')
-               || confess "Type cosntraint parameter must be a code-ref, not " . $options{type_constraint}
-                       if exists $options{type_constraint};            
+       }               
 });
 
 sub generate_accessor_method {
@@ -55,7 +54,7 @@ sub generate_accessor_method {
                if ($self->has_weak_ref) {
                    return sub {
                                if (scalar(@_) == 2) {
-                                       (defined $self->type_constraint->($_[1]))
+                                       (defined $self->type_constraint->constraint_code->($_[1]))
                                                || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                        if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];
@@ -68,8 +67,8 @@ sub generate_accessor_method {
                    if ($self->has_coercion) {
                    return sub {
                                if (scalar(@_) == 2) {
-                                   my $val = $self->coerce->($_[1]);
-                                       (defined $self->type_constraint->($val))
+                                   my $val = $self->type_constraint->coercion_code->($_[1]);
+                                       (defined $self->type_constraint->constraint_code->($val))
                                                || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
                                                        if defined $val;
                                $_[0]->{$attr_name} = $val;
@@ -80,7 +79,7 @@ sub generate_accessor_method {
                    else {
                    return sub {
                                if (scalar(@_) == 2) {
-                                       (defined $self->type_constraint->($_[1]))
+                                       (defined $self->type_constraint->constraint_code->($_[1]))
                                                || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                        if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];
@@ -114,7 +113,7 @@ sub generate_writer_method {
        if ($self->has_type_constraint) {
                if ($self->has_weak_ref) {
                    return sub { 
-                               (defined $self->type_constraint->($_[1]))
+                               (defined $self->type_constraint->constraint_code->($_[1]))
                                        || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];
@@ -124,8 +123,8 @@ sub generate_writer_method {
                else {
                    if ($self->has_coercion) {  
                    return sub { 
-                       my $val = $self->coerce->($_[1]);
-                               (defined $self->type_constraint->($val))
+                       my $val = $self->type_constraint->coercion_code->($_[1]);
+                               (defined $self->type_constraint->constraint_code->($val))
                                        || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
                                                if defined $val;
                                $_[0]->{$attr_name} = $val;
@@ -133,7 +132,7 @@ sub generate_writer_method {
                    }
                    else {          
                    return sub { 
-                               (defined $self->type_constraint->($_[1]))
+                               (defined $self->type_constraint->constraint_code->($_[1]))
                                        || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index f2fe062..014dc7b 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -22,12 +22,12 @@ sub construct_instance {
         # attribute's default value (if it has one)
         $val ||= $attr->default($instance) if $attr->has_default; 
                if (defined $val) {
-                   if ($attr->has_coercion) {
-                       $val = $attr->coerce->($val);
-                   }
                    if ($attr->has_type_constraint) {
-                (defined($attr->type_constraint->($val))) 
-                    || confess "Attribute () does not pass the type contraint with";                   
+                   if ($attr->has_coercion && $attr->type_constraint->has_coercion) {
+                       $val = $attr->type_constraint->coercion_code->($val);
+                   }   
+                (defined($attr->type_constraint->constraint_code->($val))) 
+                    || confess "Attribute (" . $attr->name . ") does not pass the type contraint with";                        
             }
                }
         $instance->{$attr->name} = $val;

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 785ba5c..651b1bf 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -25,9 +25,7 @@ Moose::Meta::TypeConstraint->meta->add_attribute(
     )) 
 );
 
-sub new    { (shift)->meta->new_object(@_)  }
-sub check  { (shift)->constraint_code->(@_) }
-sub coerce { (shift)->coercion_code->(@_)   }
+sub new { return (shift)->meta->new_object(@_)  }
 
 1;
 

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index eb5524d..e32da46 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -39,12 +39,6 @@ sub import {
         );
     }
     
-    sub dump_type_constraints {
-        require Data::Dumper;
-        $Data::Dumper::Deparse = 1;
-        Data::Dumper::Dumper(\%TYPES);
-    }
-    
     sub export_type_contstraints_as_functions {
         my $pkg = caller();
            no strict 'refs';

diff --git a/t/001_basic.t b/t/001_basic.t
index 49430ff..7fc3718 100644 (file)
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 43;
+use Test::More tests => 55;
 use Test::Exception;
 
 BEGIN {
@@ -144,6 +144,14 @@ foreach my $method (@Point_methods) {
        ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
 }
 
+foreach my $attr_name (@Point_attrs ) {
+       ok(Point->meta->has_attribute($attr_name), '... Point has the attribute "' . $attr_name . '"');    
+    my $attr = Point->meta->get_attribute($attr_name);
+       ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
+       isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint');  
+    is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');    
+}
+
 # poke at Point3D
 
 is_deeply(
@@ -167,3 +175,11 @@ is_deeply(
 foreach my $method (@Point3D_methods) {
        ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
 }
+
+foreach my $attr_name (@Point3D_attrs ) {
+       ok(Point3D->meta->has_attribute($attr_name), '... Point3D has the attribute "' . $attr_name . '"');    
+    my $attr = Point3D->meta->get_attribute($attr_name);
+       ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
+       isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint');  
+    is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');    
+}