1 package MooseX::Types::TypeDecorator;
6 use Carp::Clan qw( ^MooseX::Types );
7 use Moose::Util::TypeConstraints ();
8 use Moose::Meta::TypeConstraint::Union;
12 shift->__type_constraint->name;
15 my @tc = grep {ref $_} @_;
16 my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
17 return Moose::Util::TypeConstraints::register_type_constraint($union);
23 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
27 This is a decorator object that contains an underlying type constraint. We use
28 this to control access to the type constraint and to add some features.
32 This class defines the following methods.
36 Old school instantiation
42 if(my $arg = shift @_) {
43 if(ref $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
44 return bless {'__type_constraint'=>$arg}, $class;
45 } elsif(ref $arg && $arg->isa('MooseX::Types::UndefinedType')) {
46 ## stub in case we'll need to handle these types differently
47 return bless {'__type_constraint'=>$arg}, $class;
49 croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType')";
52 croak "This method [new] requires a single argument";
56 =head type_constraint ($type_constraint)
58 Set/Get the type_constraint.
62 sub __type_constraint {
64 if(defined(my $tc = shift @_)) {
65 $self->{__type_constraint} = $tc;
67 return $self->{__type_constraint};
72 handle $self->isa since AUTOLOAD can't.
77 my ($self, $target) = @_;
79 return $self->__type_constraint->isa($target);
87 handle $self->can since AUTOLOAD can't.
92 my ($self, $target) = @_;
94 return $self->__type_constraint->can($target);
102 We might need it later
112 Delegate to the decorator targe
117 my ($self, @args) = @_;
118 my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
119 if($self->__type_constraint->can($method)) {
120 return $self->__type_constraint->$method(@args);
122 croak "Method '$method' is not supported";
126 =head1 AUTHOR AND COPYRIGHT
128 John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org>
132 This program is free software; you can redistribute it and/or modify
133 it under the same terms as perl itself.