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...
  14         my $names = join('|', @names);
  15         Moose::Util::TypeConstraints::create_type_constraint_union($names);
  16     },
  17 );
  18
  19 =head1 NAME
  20
  21 MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
  22
  23 =head1 DESCRIPTION
  24
  25 This is a decorator object that contains an underlying type constraint.  We use
  26 this to control access to the type constraint and to add some features.
  27
  28 =head1 METHODS
  29
  30 This class defines the following methods.
  31
  32 =head2 new
  33
  34 Old school instantiation
  35
  36 =cut
  37
  38 sub new {
  39     my ($class, %args) = @_;
  40     return bless \%args, $class;
  41 }
  42
  43 =head type_constraint ($type_constraint)
  44
  45 Set/Get the type_constraint
  46
  47 =cut
  48
  49 sub type_constraint {
  50     my $self = shift @_;
  51     if(my $tc = shift @_) {
  52         $self->{type_constraint} = $tc;
  53     }
  54     return $self->{type_constraint};
  55 }
  56
  57 =head2 DESTROY
  58
  59 We might need it later
  60
  61 =cut
  62
  63 sub DESTROY {
  64     return;
  65 }
  66
  67 =head2 AUTOLOAD
  68
  69 Delegate to the decorator targe
  70
  71 =cut
  72
  73 sub AUTOLOAD
  74 {
  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;