use strict;
use warnings;
+use Carp::Clan qw( ^MooseX::Types );
+use Moose::Util::TypeConstraints ();
+use Moose::Meta::TypeConstraint::Union;
+
use overload(
'""' => sub {
- shift->type_constraint->name;
+ shift->__type_constraint->name;
+ },
+ '|' => sub {
+ my @tc = grep {ref $_} @_;
+ my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
+ return Moose::Util::TypeConstraints::register_type_constraint($union);
},
);
=cut
sub new {
- my ($class, %args) = @_;
- return bless \%args, $class;
+ my $class = shift @_;
+ if(my $arg = shift @_) {
+ if(ref $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
+ return bless {'__type_constraint'=>$arg}, $class;
+ } elsif(ref $arg && $arg->isa('MooseX::Types::UndefinedType')) {
+ ## stub in case we'll need to handle these types differently
+ return bless {'__type_constraint'=>$arg}, $class;
+ } else {
+ croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType')";
+ }
+ } else {
+ croak "This method [new] requires a single argument";
+ }
}
=head type_constraint ($type_constraint)
-Set/Get the type_constraint
+Set/Get the type_constraint.
=cut
-sub type_constraint {
+sub __type_constraint {
my $self = shift @_;
- if(my $tc = shift @_) {
- $self->{type_constraint} = $tc;
+ if(defined(my $tc = shift @_)) {
+ $self->{__type_constraint} = $tc;
+ }
+ return $self->{__type_constraint};
+}
+
+=head2 isa
+
+handle $self->isa since AUTOLOAD can't.
+
+=cut
+
+sub isa {
+ my ($self, $target) = @_;
+ if(defined $target) {
+ return $self->__type_constraint->isa($target);
+ } else {
+ return;
+ }
+}
+
+=head2 can
+
+handle $self->can since AUTOLOAD can't.
+
+=cut
+
+sub can {
+ my ($self, $target) = @_;
+ if(defined $target) {
+ return $self->__type_constraint->can($target);
+ } else {
+ return;
}
- return $self->{type_constraint};
}
=head2 DESTROY
=cut
-sub AUTOLOAD
-{
+sub AUTOLOAD {
+ my ($self, @args) = @_;
my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
- return shift->type_constraint->$method(@_);
+ if($self->__type_constraint->can($method)) {
+ return $self->__type_constraint->$method(@args);
+ } else {
+ croak "Method '$method' is not supported";
+ }
}
=head1 AUTHOR AND COPYRIGHT