up

diff --git a/Changes b/Changes
index 7a3f770..fc8b0ca 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,16 +2,49 @@ Revision history for Perl extension Moose
 
 0.02 
     * Moose
-        - many more tests, fixing some bugs/edge 
-          and cases, general development work
-        - &extends now loads the base module with
-          UNIVERSAL::require 
-            - added UNIVERSAL::require to the 
-              dependencies list
+      - many more tests, fixing some bugs and  
+        edge cases
+        
+      - &extends now loads the base module with
+        UNIVERSAL::require 
+        - added UNIVERSAL::require to the 
+          dependencies list
+
+      # API CHANGES #
+      
+      - each new Moose class will also create 
+        and register a subtype of Object which 
+        correspond to the new Moose class.      
+      
+      - the 'isa' option in &has now only 
+        accepts strings, and will DWIM in 
+        almost all cases
+    
+    * Moose::Util::TypeConstraints
+      - added type coercion features
+        - added tests for this
+        - added support for this in attributes 
+          and instance construction
+          
+      # API CHANGES #          
+          
+      - type construction no longer creates a 
+        function, it registers the type instead.
+        - added several functions to get the 
+          registered types 
+    
+    * Moose::Meta::Attribute
+      - adding support for coercion in the
+        autogenerated accessors
+        
+    * Moose::Meta::Class
+      - adding support for coercion in the
+        instance construction        
     
     * Moose::Object
-        - BUILDALL and DEMOLISHALL were broken 
-          because of a mis-named hash key, Whoops :)
+    
+      - BUILDALL and DEMOLISHALL were broken 
+        because of a mis-named hash key, Whoops :)
 
 0.01 Wed. March 15, 2006
     - Moooooooooooooooooose!!!
\ No newline at end of file

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index bd16e11..332af9e 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -122,12 +122,23 @@ sub generate_writer_method {
                        };
                }
                else {
-                   return sub { 
-                               (defined $self->type_constraint->($_[1]))
-                                       || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
-                                               if defined $_[1];
-                               $_[0]->{$attr_name} = $_[1];
-                       };                      
+                   if ($self->has_coercion) {  
+                   return sub { 
+                       my $val = $self->coerce->($_[1]);
+                               (defined $self->type_constraint->($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->($_[1]))
+                                       || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
+                                               if defined $_[1];
+                               $_[0]->{$attr_name} = $_[1];
+                       };      
+               }               
                }
        }
        else {

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 362ad54..395a8dc 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -112,6 +112,7 @@ sub coerce ($@) {
         foreach my $coercion (@coercions) {
             my ($constraint, $converter) = @$coercion;
             if (defined $constraint->($thing)) {
+                           local $_ = $thing;                
                 return $converter->($thing);
             }
         }

diff --git a/t/004_basic.t b/t/004_basic.t
index e5a9665..e9ac66d 100644 (file)
--- a/t/004_basic.t
+++ b/t/004_basic.t
@@ -12,7 +12,6 @@ BEGIN {
 }
 
 use Test::Exception;
-
 use Scalar::Util 'isweak';
 
 BEGIN {

diff --git a/t/006_basic.t b/t/006_basic.t
new file mode 100644 (file)
index 0000000..769fc52
--- /dev/null
+++ b/t/006_basic.t
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    eval "use HTTP::Headers; use Params::Coerce; use URI;";
+    plan skip_all => "HTTP::Headers & Params::Coerce & URI required for this test" if $@;        
+    plan no_plan => 1;    
+}
+
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+       package Request;
+       use strict;
+       use warnings;
+       use Moose;
+       
+       use HTTP::Headers  ();
+       use Params::Coerce ();
+       use URI            ();
+
+       subtype Header
+           => as Object
+           => where { $_->isa('HTTP::Headers') };
+
+       coerce Header
+           => from ArrayRef
+               => via { HTTP::Headers->new( @{ $_ } ) }
+           => from HashRef
+               => via { HTTP::Headers->new( %{ $_ } ) };
+
+       subtype Uri
+           => as Object
+           => where { $_->isa('URI') };
+
+       coerce Uri
+           => from Object
+               => via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) }
+           => from Str
+               => via { URI->new( $_, 'http' ) };
+
+       subtype Protocol
+           => as Str
+           => where { /^HTTP\/[0-9]\.[0-9]$/ };
+
+
+       has 'base'     => (is => 'rw', isa => 'Uri', coerce  => 1);
+       has 'url'      => (is => 'rw', isa => 'Uri', coerce  => 1);     
+       has 'method'   => (is => 'rw', isa => 'Str');   
+       has 'protocol' => (is => 'rw', isa => 'Protocol');              
+       has 'headers'  => (
+           is      => 'rw',
+           isa     => 'Header',
+           coerce  => 1,
+           default => sub { HTTP::Headers->new } 
+    );
+}
+
+my $r = Request->new;
+isa_ok($r, 'Request');
+
+{
+    my $header = $r->headers;
+    isa_ok($header, 'HTTP::Headers');
+
+    is($r->headers->content_type, '', '... got no content type in the header');
+
+    $r->headers( { content_type => 'text/plain' } );
+
+    my $header2 = $r->headers;
+    isa_ok($header2, 'HTTP::Headers');
+    isnt($header, $header2, '... created a new HTTP::Header object');
+
+    is($header2->content_type, 'text/plain', '... got the right content type in the header');
+
+    $r->headers( [ content_type => 'text/html' ] );
+
+    my $header3 = $r->headers;
+    isa_ok($header3, 'HTTP::Headers');
+    isnt($header2, $header3, '... created a new HTTP::Header object');
+
+    is($header3->content_type, 'text/html', '... got the right content type in the header');
+    
+    $r->headers( HTTP::Headers->new(content_type => 'application/pdf') );
+    
+    my $header4 = $r->headers;    
+    isa_ok($header4, 'HTTP::Headers');
+    isnt($header3, $header4, '... created a new HTTP::Header object');
+
+    is($header4->content_type, 'application/pdf', '... got the right content type in the header');    
+    
+    dies_ok {
+        $r->headers('Foo')
+    } '... dies when it gets bad params';
+}
+
+
+