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 @args = @_[0,1]; ## arg 3 is special, see the overload docs.
28 my @tc = grep {blessed $_} map {
30 Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
31 || __PACKAGE__->_throw_error( "$_ is not a type constraint")
34 ( scalar @tc == scalar @args)
35 || __PACKAGE__->_throw_error(
36 "one of your type constraints is bad. Passed: ". join(', ', @args) ." Got: ". join(', ', @tc));
39 || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union");
41 my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
42 return Moose::Util::TypeConstraints::register_type_constraint($union);
50 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
54 This is a decorator object that contains an underlying type constraint. We use
55 this to control access to the type constraint and to add some features.
59 This class defines the following methods.
63 Old school instantiation
69 if(my $arg = shift @_) {
70 if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
71 return bless {'__type_constraint'=>$arg}, $class;
74 $arg->isa('MooseX::Types::UndefinedType')
76 ## stub in case we'll need to handle these types differently
77 return bless {'__type_constraint'=>$arg}, $class;
78 } elsif(blessed $arg) {
79 __PACKAGE__->_throw_error("Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg);
81 __PACKAGE__->_throw_error("Argument cannot be '$arg'");
84 __PACKAGE__->_throw_error("This method [new] requires a single argument.");
88 =head2 __type_constraint ($type_constraint)
90 Set/Get the type_constraint.
94 sub __type_constraint {
97 if(defined(my $tc = shift @_)) {
98 $self->{__type_constraint} = $tc;
100 return $self->{__type_constraint};
102 __PACKAGE__->_throw_error('cannot call __type_constraint as a class method');
108 handle $self->isa since AUTOLOAD can't.
113 my ($self, $target) = @_;
114 if(defined $target) {
116 return $self->__type_constraint->isa($target);
128 handle $self->can since AUTOLOAD can't.
133 my ($self, $target) = @_;
134 if(defined $target) {
136 return $self->__type_constraint->can($target);
147 have meta examine the underlying type constraints
154 return $self->__type_constraint->meta;
160 properly delegate error messages
168 goto &Moose::throw_error;
173 We might need it later
183 Delegate to the decorator targe
189 my ($self, @args) = @_;
190 my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
192 ## We delegate with this method in an attempt to support a value of
193 ## __type_constraint which is also AUTOLOADing, in particular the class
194 ## MooseX::Types::UndefinedType which AUTOLOADs during autovivication.
199 $return = $self->__type_constraint->$method(@args);
201 __PACKAGE__->_throw_error($@);
209 See L<MooseX::Types/AUTHOR>.
213 This program is free software; you can redistribute it and/or modify
214 it under the same terms as perl itself.