lib/MooseX/Types/TypeDecorator.pm

   1 package MooseX::Types::TypeDecorator;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Util::TypeConstraints;
   7 use overload(
   8     '""' => sub {
   9         shift->type_constraint->name;
  10     },
  11     '|' => sub {
  12         my @names = grep {$_} map {"$_"} @_;
  13         ## Don't know why I can't use the array version of this...  If someone
  14         ## knows would like to hear from you.
  15         my $names = join('|', @names);
  16         Moose::Util::TypeConstraints::create_type_constraint_union($names);
  17     },
  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
  29 =head1 METHODS
  30
  31 This class defines the following methods.
  32
  33 =head2 new
  34
  35 Old school instantiation
  36
  37 =cut
  38
  39 sub new {
  40     my ($class, %args) = @_;
  41     return bless \%args, $class;
  42 }
  43
  44 =head type_constraint ($type_constraint)
  45
  46 Set/Get the type_constraint.
  47
  48 =cut
  49
  50 sub type_constraint {
  51     my $self = shift @_;
  52     if(defined(my $tc = shift @_)) {
  53         $self->{type_constraint} = $tc;
  54     }
  55     return $self->{type_constraint};
  56 }
  57
  58 =head2 DESTROY
  59
  60 We might need it later
  61
  62 =cut
  63
  64 sub DESTROY {
  65     return;
  66 }
  67
  68 =head2 AUTOLOAD
  69
  70 Delegate to the decorator targe
  71
  72 =cut
  73
  74 sub AUTOLOAD {
  75     my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
  76     return shift->type_constraint->$method(@_);
  77 }
  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;