1 package MooseX::Types::TypeDecorator;
7 use Carp::Clan qw( ^MooseX::Types );
8 use Moose::Util::TypeConstraints ();
9 use Moose::Meta::TypeConstraint::Union;
10 use Scalar::Util qw(blessed);
16 return $self->__type_constraint->name;
23 ## It's kind of ugly that we need to know about Union Types, but this
24 ## is needed for syntax compatibility. Maybe someday we'll all just do
27 my @tc = grep {blessed $_} @_;
28 my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
29 return Moose::Util::TypeConstraints::register_type_constraint($union);
37 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
41 This is a decorator object that contains an underlying type constraint. We use
42 this to control access to the type constraint and to add some features.
46 This class defines the following methods.
50 Old school instantiation
56 if(my $arg = shift @_) {
57 if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
58 return bless {'__type_constraint'=>$arg}, $class;
61 $arg->isa('MooseX::Types::UndefinedType')
63 ## stub in case we'll need to handle these types differently
64 return bless {'__type_constraint'=>$arg}, $class;
65 } elsif(blessed $arg) {
66 croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg;
68 croak "Argument cannot be '$arg'";
71 croak "This method [new] requires a single argument.";
75 =head __type_constraint ($type_constraint)
77 Set/Get the type_constraint.
81 sub __type_constraint {
84 if(defined(my $tc = shift @_)) {
85 $self->{__type_constraint} = $tc;
87 return $self->{__type_constraint};
89 croak 'cannot call __type_constraint as a class method';
95 handle $self->isa since AUTOLOAD can't.
100 my ($self, $target) = @_;
101 if(defined $target) {
103 return $self->__type_constraint->isa($target);
114 handle $self->can since AUTOLOAD can't.
119 my ($self, $target) = @_;
120 if(defined $target) {
122 return $self->__type_constraint->can($target);
133 have meta examine the underlying type constraints
140 return $self->__type_constraint->meta;
147 We might need it later
157 Delegate to the decorator targe
163 my ($self, @args) = @_;
164 my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
166 ## We delegate with this method in an attempt to support a value of
167 ## __type_constraint which is also AUTOLOADing, in particular the class
168 ## MooseX::Types::UndefinedType which AUTOLOADs during autovivication.
173 $return = $self->__type_constraint->$method(@args);
181 =head1 AUTHOR AND COPYRIGHT
183 John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org>
187 This program is free software; you can redistribute it and/or modify
188 it under the same terms as perl itself.