X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FTypeDecorator.pm;h=ebe0f5d5304c0dfec57fb4f5cec6f9ae2c8637d8;hb=c1260541fc8dffb9e348c5fdd8b6d3c99b247677;hp=31dd3fd4ea2abfca3ef953eb15220163ebf7c60a;hpb=1d9a68a6937a9e145f35ac66cc99609b71414b00;p=gitmo%2FMooseX-Types.git

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 31dd3fd..ebe0f5d 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -3,6 +3,7 @@ package MooseX::Types::TypeDecorator;
 use strict;
 use warnings;
 
+
 use Carp::Clan qw( ^MooseX::Types );
 use Moose::Util::TypeConstraints ();
 use Moose::Meta::TypeConstraint::Union;
@@ -10,7 +11,12 @@ use Scalar::Util qw(blessed);
 
 use overload(
     '""' => sub {
-        return shift->__type_constraint->name; 
+    		my $self = shift @_;
+    		if(blessed $self) {
+        		return $self->__type_constraint->name;     		
+    		} else {
+    			return "$self";
+    		}
     },
     '|' => sub {
         
@@ -26,7 +32,6 @@ use overload(
     
 );
 
-
 =head1 NAME
 
 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
@@ -51,7 +56,10 @@ sub new {
     if(my $arg = shift @_) {
         if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
             return bless {'__type_constraint'=>$arg}, $class;
-        } elsif(blessed $arg && $arg->isa('MooseX::Types::UndefinedType')) {
+        } elsif(
+            blessed $arg &&
+            $arg->isa('MooseX::Types::UndefinedType') 
+          ) {
             ## stub in case we'll need to handle these types differently
             return bless {'__type_constraint'=>$arg}, $class;
         } elsif(blessed $arg) {
@@ -60,7 +68,7 @@ sub new {
             croak "Argument cannot be '$arg'";
         }
     } else {
-        croak "This method [new] requires a single argument of 'arg'.";        
+        croak "This method [new] requires a single argument.";        
     }
 }
 
@@ -71,8 +79,7 @@ Set/Get the type_constraint.
 =cut
 
 sub __type_constraint {
-    my $self = shift @_;
-    
+    my $self = shift @_;    
     if(blessed $self) {
         if(defined(my $tc = shift @_)) {
             $self->{__type_constraint} = $tc;
@@ -92,7 +99,11 @@ handle $self->isa since AUTOLOAD can't.
 sub isa {
     my ($self, $target) = @_;  
     if(defined $target) {
-        return $self->__type_constraint->isa($target);
+    	if(blessed $self) {
+    		return $self->__type_constraint->isa($target);
+    	} else {
+    		return;
+    	}
     } else {
         return;
     }
@@ -107,12 +118,30 @@ handle $self->can since AUTOLOAD can't.
 sub can {
     my ($self, $target) = @_;
     if(defined $target) {
-        return $self->__type_constraint->can($target);
+    	if(blessed $self) {
+    		return $self->__type_constraint->can($target);
+    	} else {
+    		return;
+    	}
     } else {
         return;
     }
 }
 
+=head2 meta
+
+have meta examine the underlying type constraints
+
+=cut
+
+sub meta {
+	my $self = shift @_;
+	if(blessed $self) {
+		return $self->__type_constraint->meta;
+	} 
+}
+
+
 =head2 DESTROY
 
 We might need it later
@@ -130,12 +159,22 @@ Delegate to the decorator targe
 =cut
 
 sub AUTOLOAD {
+    
     my ($self, @args) = @_;
     my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
-    if($self->__type_constraint->can($method)) {
-        return $self->__type_constraint->$method(@args);
+    
+    ## We delegate with this method in an attempt to support a value of
+    ## __type_constraint which is also AUTOLOADing, in particular the class
+    ## MooseX::Types::UndefinedType which AUTOLOADs during autovivication.
+    
+    my $return;
+    
+    eval {
+        $return = $self->__type_constraint->$method(@args);
+    }; if($@) {
+        croak $@;
     } else {
-        croak "Method '$method' is not supported";   
+        return $return;
     }
 }