From: John Napiorkowski Date: Tue, 7 Oct 2008 22:19:57 +0000 (+0000) Subject: better error checking, more correct stringification X-Git-Tag: 0.06~4^2~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=371efa059c4aa335fd246c4bc17bce6c1f3a73a9 better error checking, more correct stringification --- diff --git a/Makefile.PL b/Makefile.PL index 4fa80b6..0ef75c5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,12 +18,12 @@ requires q{namespace::clean}, 0.08; requires q{Carp}, 0; requires q{Carp::Clan}, 6.00; requires q{Class::MOP}, 0.65; +requires q{UNIVERSAL::ref}, 0.12; +requires q{Scalar::Util} 1.19; system 'pod2text lib/MooseX/Types.pm > README' if -e 'MANIFEST.SKIP'; auto_provides; - auto_install; - WriteAll; diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index 06b285f..0791eda 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -20,7 +20,6 @@ use Carp::Clan qw( ^MooseX::Types ); use namespace::clean -except => [qw( meta )]; our $VERSION = 0.06; - my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'}; =head1 SYNOPSIS @@ -382,8 +381,8 @@ it with @args. =cut sub create_arged_type_constraint { - my ($class, $name, @args) = @_; - my $type_constraint = Moose::Util::TypeConstraints::find_or_create_type_constraint($name); + my ($class, $name, @args) = @_; + my $type_constraint = Moose::Util::TypeConstraints::find_or_create_type_constraint("$name"); return $type_constraint->parameterize(@args); } diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm index 79c77ee..3d74d30 100644 --- a/lib/MooseX/Types/TypeDecorator.pm +++ b/lib/MooseX/Types/TypeDecorator.pm @@ -6,6 +6,7 @@ use warnings; use Carp::Clan qw( ^MooseX::Types ); use Moose::Util::TypeConstraints (); use Moose::Meta::TypeConstraint::Union; +use Scalar::Util qw(blessed); use overload( '""' => sub { @@ -17,12 +18,13 @@ use overload( ## is needed for syntax compatibility. Maybe someday we'll all just do ## Or[Str,Str,Int] - my @tc = grep {ref $_} @_; + my @tc = grep {blessed $_} @_; my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc); return Moose::Util::TypeConstraints::register_type_constraint($union); }, ); + =head1 NAME MooseX::Types::TypeDecorator - More flexible access to a Type Constraint @@ -45,13 +47,13 @@ Old school instantiation sub new { my $class = shift @_; if(my $arg = shift @_) { - if(ref $arg && $arg->isa('Moose::Meta::TypeConstraint')) { + if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) { return bless {'__type_constraint'=>$arg}, $class; - } elsif(ref $arg && $arg->isa('MooseX::Types::UndefinedType')) { + } elsif(blessed $arg && $arg->isa('MooseX::Types::UndefinedType')) { ## stub in case we'll need to handle these types differently return bless {'__type_constraint'=>$arg}, $class; - } elsif(ref $arg) { - croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". ref $arg; + } elsif(blessed $arg) { + croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg; } else { croak "Argument cannot be '$arg'"; } @@ -68,10 +70,15 @@ Set/Get the type_constraint. sub __type_constraint { my $self = shift @_; - if(defined(my $tc = shift @_)) { - $self->{__type_constraint} = $tc; + + if(blessed $self) { + if(defined(my $tc = shift @_)) { + $self->{__type_constraint} = $tc; + } + return $self->{__type_constraint}; + } else { + croak 'cannot call __type_constraint as a class method'; } - return $self->{__type_constraint}; } =head2 isa @@ -81,7 +88,7 @@ handle $self->isa since AUTOLOAD can't. =cut sub isa { - my ($self, $target) = @_; + my ($self, $target) = @_; if(defined $target) { return $self->__type_constraint->isa($target); } else {