type-coercion-meta-object

[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 464aa66..a2e9672 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -7,33 +7,28 @@ use warnings;
 use Scalar::Util 'weaken', 'reftype';
 use Carp         'confess';
 
-use Moose::Util::TypeConstraints ':no_export';
-
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use base 'Class::MOP::Attribute';
 
-Moose::Meta::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('weak_ref' => (
-        reader    => 'weak_ref',
-        predicate => {
-                       'has_weak_ref' => sub { $_[0]->weak_ref() ? 1 : 0 }
-               }
-    )) 
-);
+__PACKAGE__->meta->add_attribute('coerce'          => (reader => 'coerce'));
+__PACKAGE__->meta->add_attribute('weak_ref'        => (reader => 'weak_ref'));
+__PACKAGE__->meta->add_attribute('type_constraint' => (
+    reader    => 'type_constraint',
+    predicate => 'has_type_constraint',
+));
 
-Moose::Meta::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('type_constraint' => (
-        reader    => 'type_constraint',
-        predicate => 'has_type_constraint',
-    )) 
-);
+sub has_coercion { (shift)->coerce()   ? 1 : 0 }
+sub has_weak_ref { (shift)->weak_ref() ? 1 : 0 }
 
-Moose::Meta::Attribute->meta->add_before_method_modifier('new' => sub {
+__PACKAGE__->meta->add_before_method_modifier('new' => sub {
        my (undef, undef, %options) = @_;
-       (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};            
+       if (exists $options{coerce} && $options{coerce}) {
+           (exists $options{type_constraint})
+               || 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};             
+       }               
 });
 
 sub generate_accessor_method {
@@ -42,8 +37,8 @@ sub generate_accessor_method {
                if ($self->has_weak_ref) {
                    return sub {
                                if (scalar(@_) == 2) {
-                                       (defined $self->type_constraint->($_[1]))
-                                               || confess "Attribute ($attr_name) does not pass the type contraint"
+                                       (defined $self->type_constraint->check($_[1]))
+                                               || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                        if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];
                                        weaken($_[0]->{$attr_name});
@@ -52,15 +47,29 @@ sub generate_accessor_method {
                    };                  
                }
                else {
-                   return sub {
-                               if (scalar(@_) == 2) {
-                                       (defined $self->type_constraint->($_[1]))
-                                               || confess "Attribute ($attr_name) does not pass the type contraint"
-                                                       if defined $_[1];
-                               $_[0]->{$attr_name} = $_[1];
-                               }
-                       $_[0]->{$attr_name};
-                   };  
+                   if ($self->has_coercion) {
+                   return sub {
+                               if (scalar(@_) == 2) {
+                                   my $val = $self->type_constraint->coercion->coerce($_[1]);
+                                       (defined $self->type_constraint->check($val))
+                                               || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
+                                                       if defined $val;
+                               $_[0]->{$attr_name} = $val;
+                               }
+                       $_[0]->{$attr_name};
+                   };                  
+                   }
+                   else {
+                   return sub {
+                               if (scalar(@_) == 2) {
+                                       (defined $self->type_constraint->check($_[1]))
+                                               || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
+                                                       if defined $_[1];
+                               $_[0]->{$attr_name} = $_[1];
+                               }
+                       $_[0]->{$attr_name};
+                   };
+                   }   
                }       
        }
        else {
@@ -87,20 +96,31 @@ sub generate_writer_method {
        if ($self->has_type_constraint) {
                if ($self->has_weak_ref) {
                    return sub { 
-                               (defined $self->type_constraint->($_[1]))
-                                       || confess "Attribute ($attr_name) does not pass the type contraint"
+                               (defined $self->type_constraint->check($_[1]))
+                                       || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
                                                if defined $_[1];
                                $_[0]->{$attr_name} = $_[1];
                                weaken($_[0]->{$attr_name});
                        };
                }
                else {
-                   return sub { 
-                               (defined $self->type_constraint->($_[1]))
-                                       || confess "Attribute ($attr_name) does not pass the type contraint"
-                                               if defined $_[1];
-                               $_[0]->{$attr_name} = $_[1];
-                       };                      
+                   if ($self->has_coercion) {  
+                   return sub { 
+                       my $val = $self->type_constraint->coercion->coerce($_[1]);
+                               (defined $self->type_constraint->check($val))
+                                       || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
+                                               if defined $val;
+                               $_[0]->{$attr_name} = $val;
+                       };                      
+                   }
+                   else {          
+                   return sub { 
+                               (defined $self->type_constraint->check($_[1]))
+                                       || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
+                                               if defined $_[1];
+                               $_[0]->{$attr_name} = $_[1];
+                       };      
+               }               
                }
        }
        else {
@@ -124,12 +144,15 @@ __END__
 
 =head1 NAME
 
-Moose::Meta::Attribute - 
+Moose::Meta::Attribute - The Moose attribute metaobject
 
 =head1 SYNOPSIS
 
 =head1 DESCRIPTION
 
+This is a subclass of L<Class::MOP::Attribute> with Moose specific 
+extensions.
+
 =head1 METHODS
 
 =over 4
@@ -152,6 +175,10 @@ Moose::Meta::Attribute -
 
 =item B<weak_ref>
 
+=item B<coerce>
+
+=item B<has_coercion>
+
 =back
 
 =head1 BUGS
@@ -160,13 +187,6 @@ All complex software has bugs lurking in it, and this module is no
 exception. If you find a bug please either email me, or add the bug
 to cpan-RT.
 
-=head1 CODE COVERAGE
-
-I use L<Devel::Cover> to test the code coverage of my tests, below is the 
-L<Devel::Cover> report on this module's test suite.
-
-=head1 ACKNOWLEDGEMENTS
-
 =head1 AUTHOR
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>