Commit | Line | Data |
---|---|---|
4c2125a4 | 1 | package MooseX::Types::TypeDecorator; |
2 | ||
a706b0f2 | 3 | use strict; |
4 | use warnings; | |
4c2125a4 | 5 | |
cf1a8bfa | 6 | use Moose::Util::TypeConstraints; |
4c2125a4 | 7 | use overload( |
8 | '""' => sub { | |
9 | shift->type_constraint->name; | |
10 | }, | |
cf1a8bfa | 11 | '|' => sub { |
12 | my @names = grep {$_} map {"$_"} @_; | |
e088dd03 | 13 | ## Don't know why I can't use the array version of this... If someone |
14 | ## knows would like to hear from you. | |
cf1a8bfa | 15 | my $names = join('|', @names); |
16 | Moose::Util::TypeConstraints::create_type_constraint_union($names); | |
17 | }, | |
4c2125a4 | 18 | ); |
19 | ||
20 | =head1 NAME | |
21 | ||
22 | MooseX::Types::TypeDecorator - More flexible access to a Type Constraint | |
23 | ||
24 | =head1 DESCRIPTION | |
25 | ||
26 | This is a decorator object that contains an underlying type constraint. We use | |
27 | this to control access to the type constraint and to add some features. | |
28 | ||
a706b0f2 | 29 | =head1 METHODS |
4c2125a4 | 30 | |
a706b0f2 | 31 | This class defines the following methods. |
4c2125a4 | 32 | |
a706b0f2 | 33 | =head2 new |
4c2125a4 | 34 | |
a706b0f2 | 35 | Old school instantiation |
4c2125a4 | 36 | |
37 | =cut | |
38 | ||
a706b0f2 | 39 | sub new { |
40 | my ($class, %args) = @_; | |
41 | return bless \%args, $class; | |
42 | } | |
4c2125a4 | 43 | |
a706b0f2 | 44 | =head type_constraint ($type_constraint) |
4c2125a4 | 45 | |
e088dd03 | 46 | Set/Get the type_constraint. |
4c2125a4 | 47 | |
48 | =cut | |
49 | ||
a706b0f2 | 50 | sub type_constraint { |
51 | my $self = shift @_; | |
e088dd03 | 52 | if(defined(my $tc = shift @_)) { |
a706b0f2 | 53 | $self->{type_constraint} = $tc; |
54 | } | |
55 | return $self->{type_constraint}; | |
56 | } | |
4c2125a4 | 57 | |
a706b0f2 | 58 | =head2 DESTROY |
4c2125a4 | 59 | |
a706b0f2 | 60 | We might need it later |
4c2125a4 | 61 | |
a706b0f2 | 62 | =cut |
4c2125a4 | 63 | |
a706b0f2 | 64 | sub DESTROY { |
65 | return; | |
66 | } | |
4c2125a4 | 67 | |
a706b0f2 | 68 | =head2 AUTOLOAD |
4c2125a4 | 69 | |
a706b0f2 | 70 | Delegate to the decorator targe |
4c2125a4 | 71 | |
a706b0f2 | 72 | =cut |
4c2125a4 | 73 | |
e088dd03 | 74 | sub AUTOLOAD { |
a706b0f2 | 75 | my ($method) = (our $AUTOLOAD =~ /([^:]+)$/); |
76 | return shift->type_constraint->$method(@_); | |
77 | } | |
4c2125a4 | 78 | |
79 | =head1 AUTHOR AND COPYRIGHT | |
80 | ||
81 | John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org> | |
82 | ||
83 | =head1 LICENSE | |
84 | ||
85 | This program is free software; you can redistribute it and/or modify | |
86 | it under the same terms as perl itself. | |
87 | ||
88 | =cut | |
89 | ||
90 | 1; |