[Moose-commits] r7120 - MooseX-Types/trunk/lib/MooseX/Types

[jnapiorkowski at code2.0beta.co.uk]

Author: jnapiorkowski
Date: 2008-12-16 14:48:35 -0800 (Tue, 16 Dec 2008)
New Revision: 7120

Modified:
   MooseX-Types/trunk/lib/MooseX/Types/TypeDecorator.pm
Log:
some changes to make cases where you dont have decorated type constraints in place already work (or at least not throw an error) and also redirect any calls to meta

Modified: MooseX-Types/trunk/lib/MooseX/Types/TypeDecorator.pm
===================================================================
--- MooseX-Types/trunk/lib/MooseX/Types/TypeDecorator.pm	2008-12-16 22:25:28 UTC (rev 7119)
+++ MooseX-Types/trunk/lib/MooseX/Types/TypeDecorator.pm	2008-12-16 22:48:35 UTC (rev 7120)
@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+
 use Carp::Clan qw( ^MooseX::Types );
 use Moose::Util::TypeConstraints ();
 use Moose::Meta::TypeConstraint::Union;
@@ -10,7 +11,12 @@
 
 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 @@
     
 );
 
-
 =head1 NAME
 
 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
@@ -74,8 +79,7 @@
 =cut
 
 sub __type_constraint {
-    my $self = shift @_;
-    
+    my $self = shift @_;    
     if(blessed $self) {
         if(defined(my $tc = shift @_)) {
             $self->{__type_constraint} = $tc;
@@ -95,7 +99,11 @@
 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;
     }
@@ -110,12 +118,30 @@
 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