overloading for union constraints, more tests, some code cleanup

[gitmo/MooseX-Types.git] / lib / MooseX / Types / TypeDecorator.pm

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 42cd141..b73ccf3 100644 (file)
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -1,13 +1,19 @@
 package MooseX::Types::TypeDecorator;
 
-use Moose;
-use Moose::Util::TypeConstraints;
-use Moose::Meta::TypeConstraint ();
+use strict;
+use warnings;
 
+use Moose::Util::TypeConstraints;
 use overload(
     '""' => sub {
         shift->type_constraint->name;  
     },
+    '|' => sub {
+        my @names = grep {$_} map {"$_"} @_;
+        ## Don't know why I can't use the array version of this...
+        my $names = join('|', @names);
+        Moose::Util::TypeConstraints::create_type_constraint_union($names);
+    },
 );
 
 =head1 NAME
@@ -19,48 +25,56 @@ MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
 This is a decorator object that contains an underlying type constraint.  We use
 this to control access to the type constraint and to add some features.
 
-=head1 TYPES
+=head1 METHODS
 
-The following types are defined in this class.
+This class defines the following methods.
 
-=head2 Moose::Meta::TypeConstraint
+=head2 new
 
-Used to make sure we can properly validate incoming type constraints.
+Old school instantiation
 
 =cut
 
-class_type 'Moose::Meta::TypeConstraint';
+sub new {
+    my ($class, %args) = @_;
+    return bless \%args, $class;
+}
 
-=head2 MooseX::Types::UndefinedType
+=head type_constraint ($type_constraint)
 
-Used since sometimes our constraint is an unknown type.
+Set/Get the type_constraint
 
 =cut
 
-class_type 'MooseX::Types::UndefinedType';
+sub type_constraint {
+    my $self = shift @_;
+    if(my $tc = shift @_) {
+        $self->{type_constraint} = $tc;
+    }
+    return $self->{type_constraint};
+}
 
-=head1 ATTRIBUTES
+=head2 DESTROY
 
-This class defines the following attributes
+We might need it later
 
-=head2 type_constraint
+=cut
 
-This is the type constraint that we are delegating
+sub DESTROY {
+    return;
+}
 
-=cut
+=head2 AUTOLOAD
 
-has 'type_constraint' => (
-    is=>'ro',
-    isa=>'Moose::Meta::TypeConstraint|MooseX::Types::UndefinedType',
-    handles=>[
-        Moose::Meta::TypeConstraint->meta->compute_all_applicable_methods,
-        "_compiled_type_constraint",
-    ],
-);
+Delegate to the decorator targe
 
-=head1 METHODS
+=cut
 
-This class defines the following methods.
+sub AUTOLOAD
+{
+    my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
+    return shift->type_constraint->$method(@_);
+}
 
 =head1 AUTHOR AND COPYRIGHT