X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=b7c0558c6c1c18d24d38671efe3e2bf757cec9e5;hb=8ee73eeb7e76858f1dbe56f69101a2dc1e096559;hp=2c5e01c46ca73c9a13cd2487d82e4c8f4bb3cec2;hpb=3f7376b0954bb3d5862741dd90dcf20ec16a0c18;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 2c5e01c..b7c0558 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -7,8 +7,9 @@ use warnings;
 use Scalar::Util 'blessed', 'weaken', 'reftype';
 use Carp         'confess';
 
-our $VERSION = '0.06';
+our $VERSION = '0.08';
 
+use Moose::Meta::Method::Accessor;
 use Moose::Util::TypeConstraints ();
 
 use base 'Class::MOP::Attribute';
@@ -66,9 +67,14 @@ sub clone_and_inherit_options {
 		    (defined $type_constraint)
 		        || confess "Could not find the type constraint '" . $options{isa} . "'";
 		}
+		# NOTE:
+		# check here to see if the new type 
+		# is a subtype of the old one
 		($type_constraint->is_subtype_of($self->type_constraint->name))
 		    || confess "New type constraint setting must be a subtype of inherited one"
+		        # iff we have a type constraint that is ...
 		        if $self->has_type_constraint;
+		# then we use it :)
 		$actual_options{type_constraint} = $type_constraint;
         delete $options{isa};
     }
@@ -160,9 +166,7 @@ sub _process_options {
 	
 	if (exists $options->{coerce} && $options->{coerce}) {
 	    (exists $options->{type_constraint})
-	        || confess "You cannot have coercion without specifying a type constraint";
-	    (!$options->{type_constraint}->isa('Moose::Meta::TypeConstraint::Union'))
-	        || confess "You cannot have coercion with a type constraint union";	        
+	        || 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};	        
 	}	
@@ -170,17 +174,11 @@ sub _process_options {
 	if (exists $options->{auto_deref} && $options->{auto_deref}) {
 	    (exists $options->{type_constraint})
 	        || confess "You cannot auto-dereference without specifying a type constraint";	    
-	    ($options->{type_constraint}->name =~ /^ArrayRef|HashRef$/)
+	    ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
+         $options->{type_constraint}->is_a_type_of('HashRef'))
 	        || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef";	        
 	}
 	
-    if (exists $options->{type_constraint} && $options->{type_constraint}->name =~ /^ArrayRef|HashRef$/) {
-        unless (exists $options->{default}) {
-            $options->{default} = sub { [] } if $options->{type_constraint}->name eq 'ArrayRef';
-            $options->{default} = sub { {} } if $options->{type_constraint}->name eq 'HashRef';            
-        }
-    }
-	
 	if (exists $options->{lazy} && $options->{lazy}) {
 	    (exists $options->{default})
 	        || confess "You cannot have lazy attribute without specifying a default value for it";	    
@@ -213,7 +211,7 @@ sub initialize_instance_slot {
 	    if ($self->has_type_constraint) {
 	        my $type_constraint = $self->type_constraint;
 		    if ($self->should_coerce && $type_constraint->has_coercion) {
-		        $val = $type_constraint->coercion->coerce($val);
+		        $val = $type_constraint->coerce($val);
 		    }	
             (defined($type_constraint->check($val))) 
                 || confess "Attribute (" . 
@@ -237,7 +235,7 @@ sub _inline_check_constraint {
 	
 	# FIXME - remove 'unless defined($value) - constraint Undef
 	return sprintf <<'EOF', $value, $value, $value, $value
-defined($attr->type_constraint->check(%s))
+defined($type_constraint->(%s))
 	|| confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
        . $attr->type_constraint->name . ") with " . (defined(%s) ? "'%s'" : "undef")
   if defined(%s);
@@ -247,7 +245,7 @@ EOF
 sub _inline_check_coercion {
     my $self = shift;
 	return '' unless $self->should_coerce;
-    return 'my $val = $attr->type_constraint->coercion->coerce($_[1]);'
+    return 'my $val = $attr->type_constraint->coerce($_[1]);'
 }
 
 sub _inline_check_required {
@@ -259,6 +257,24 @@ sub _inline_check_required {
 sub _inline_check_lazy {
     my $self = shift;
 	return '' unless $self->is_lazy;
+	if ($self->has_type_constraint) {
+	    # NOTE:
+	    # this could probably be cleaned 
+	    # up and streamlined a little more
+	    return 'unless (exists $_[0]->{$attr_name}) {' .
+	           '    if ($attr->has_default) {' .
+	           '        my $default = $attr->default($_[0]);' .
+               '        (defined($type_constraint->($default)))' .
+               '        	|| confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
+               '               . $attr->type_constraint->name . ") with " . (defined($default) ? "\'$default\'" : "undef")' .
+               '          if defined($default);' .	                
+	           '        $_[0]->{$attr_name} = $default; ' .
+	           '    }' .
+	           '    else {' .
+               '        $_[0]->{$attr_name} = undef;' .
+	           '    }' .
+	           '}';	    
+	}
     return '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)'
          . 'unless exists $_[0]->{$attr_name};';
 }
@@ -296,17 +312,17 @@ sub _inline_auto_deref {
 
     return $ref_value unless $self->should_auto_deref;
 
-    my $type = $self->type_constraint->name;
+    my $type_constraint = $self->type_constraint;
 
     my $sigil;
-    if ($type eq "ArrayRef") {
+    if ($type_constraint->is_a_type_of('ArrayRef')) {
         $sigil = '@';
     } 
-    elsif ($type eq 'HashRef') {
+    elsif ($type_constraint->is_a_type_of('HashRef')) {
         $sigil = '%';
     } 
     else {
-        confess "Can not auto de-reference the type constraint '$type'";
+        confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
     }
 
     "(wantarray() ? $sigil\{ ( $ref_value ) || return } : ( $ref_value ) )";
@@ -329,6 +345,13 @@ sub generate_accessor_method {
     . $attr->_inline_check_lazy
     . 'return ' . $attr->_inline_auto_deref($attr->_inline_get($inv))
     . ' }';
+    
+    # NOTE:
+    # set up the environment
+    my $type_constraint = $attr->type_constraint 
+                                ? $attr->type_constraint->_compiled_type_constraint
+                                : undef;
+    
     my $sub = eval $code;
     confess "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@;
     return $sub;    
@@ -345,6 +368,13 @@ sub generate_writer_method {
 	. $attr->_inline_store($inv, $value_name)
 	. $attr->_inline_trigger($inv, $value_name)
     . ' }';
+    
+    # NOTE:
+    # set up the environment
+    my $type_constraint = $attr->type_constraint 
+                                ? $attr->type_constraint->_compiled_type_constraint
+                                : undef;    
+    
     my $sub = eval $code;
     confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
     return $sub;