From: John Napiorkowski Date: Thu, 4 Sep 2008 18:55:29 +0000 (+0000) Subject: incremented version and updated changelog, fixed bug that created extra coercions... X-Git-Tag: 0.06~4^2~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=475bbd1d2a14bfa42b312ab45f32d9251ccde8cd;hp=bb5b7b28b3e2fa8a6120e445ff58a0e377cf0806;p=gitmo%2FMooseX-Types.git incremented version and updated changelog, fixed bug that created extra coercions, documented usage, basically an feature complete now, just need to figure out a cleaning way to support different types of parameterized constraints --- diff --git a/Changes b/Changes index a2b51c1..297da0f 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,8 @@ +0.06 Fri Aug 5 12:00:00 EST 2008 + - Added support for parameterized types and type unions, tests for all + that and documentation updates. + 0.05 ... - moved export mechanism to Sub::Exporter. ::Base contains a bunch of wrapping logic to allow the export-along functionality diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index 0f6e7a8..c0f575b 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -19,7 +19,7 @@ use Carp::Clan qw( ^MooseX::Types ); use namespace::clean -except => [qw( meta )]; -our $VERSION = 0.05; +our $VERSION = 0.06; my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'}; @@ -31,7 +31,11 @@ my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'}; # predeclare our own types use MooseX::Types - -declare => [qw( PositiveInt NegativeInt )]; + -declare => [qw( + PositiveInt NegativeInt + ArrayRefOfPositiveInt ArrayRefOfAtLeastThreeNegativeInts + LotsOfInnerConstraints StrOrArrayRef + )]; # import builtin types use MooseX::Types::Moose 'Int'; @@ -52,6 +56,23 @@ my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'}; from Int, via { 1 }; + # with parameterized constraints. Please note the containing '(...)' + + subtype ArrayRefOfPositiveInt, + as (ArrayRef[PositiveInt]); + + subtype ArrayRefOfAtLeastThreeNegativeInts, + as (ArrayRef[NegativeInt]), + where { scalar(@$_) > 2 }; + + subtype LotsOfInnerConstraints, + as (ArrayRef[ArrayRef[HashRef[Int]]]); + + # with TypeConstraint Unions + + subtype StrOrArrayRef, + as Str|ArrayRef; + 1; =head2 Usage @@ -244,6 +265,44 @@ type does not yet exist. =back +=head1 NOTES REGARDING PARAMETERIZED CONSTRAINTS + +L uses L to do some overloading +which generally allows you to easily create types with parameters such as: + + subtype ParameterType, + as (ArrayRef[Int]); + +However, due to an outstanding issue you will need to wrap the parameterized +type inside parenthesis, as in the example above. Hopefully this limitation +will be lifted in a future version of this module. + +If you are using paramterized types in the options section of an attribute +declaration, the parenthesis are not needed: + + use Moose; + use MooseX::Types::Moose qw(HashRef Int); + + has 'attr' => (isa=>HashRef[Str]); + +=head1 NOTES REGARDING TYPE UNIONS + +L uses L to do some overloading +which generally allows you to easily create union types: + + subtype StrOrArrayRef, + as Str|ArrayRef; + +As with parameterized constrains, this overloading extends to modules using the +types you define in a type library. + + use Moose; + use MooseX::Types::Moose qw(HashRef Int); + + has 'attr' => (isa=>HashRef|Int); + +And everything should just work as you'd think. + =head1 METHODS =head2 import @@ -315,8 +374,14 @@ sub type_export_generator { } $type_constraint = defined($type_constraint) ? $type_constraint : MooseX::Types::UndefinedType->new($name); + + return $class->create_type_decorator($type_constraint); - return $class->create_type_decorator($type_constraint); + #if(@_ && wantarray) { + # return ($class->create_type_decorator($type_constraint), @_); + #} else { + # return $class->create_type_decorator($type_constraint); + #} }; } @@ -330,6 +395,10 @@ sub create_arged_type_constraint { my ($class, $name, @args) = @_; ### This whole section is a real TODO :) Ugly hack to get the base tests working. my $fullname = $name."[$args[0]]"; + + #use Data::Dump qw/dump/; + #my $tc = Moose::Util::TypeConstraints::find_or_create_type_constraint($name); + return Moose::Util::TypeConstraints::create_parameterized_type_constraint($fullname); } @@ -353,7 +422,7 @@ instance. sub create_type_decorator { my ($class, $type_constraint) = @_; - return MooseX::Types::TypeDecorator->new(type_constraint=>$type_constraint); + return MooseX::Types::TypeDecorator->new($type_constraint); } =head2 coercion_export_generator @@ -415,6 +484,8 @@ L Robert 'phaylon' Sedlacek Crs@474.atE>, with many thanks to the C<#moose> cabal on C. +Additional features by John Napiorkowski (jnapiorkowski) . + =head1 LICENSE This program is free software; you can redistribute it and/or modify diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm index f39bd55..57827b2 100644 --- a/lib/MooseX/Types/TypeDecorator.pm +++ b/lib/MooseX/Types/TypeDecorator.pm @@ -4,12 +4,12 @@ use strict; use warnings; use Carp::Clan qw( ^MooseX::Types ); -use Moose::Util::TypeConstraints; +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 $_} @_; @@ -38,17 +38,19 @@ Old school instantiation =cut sub new { - my ($class, %args) = @_; - if( - $args{type_constraint} && ref($args{type_constraint}) && - ($args{type_constraint}->isa('Moose::Meta::TypeConstraint') || - $args{type_constraint}->isa('MooseX::Types::UndefinedType')) - ) { - 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 "The argument 'type_constraint' is not valid."; + croak "This method [new] requires a single argument"; } - } =head type_constraint ($type_constraint) @@ -57,12 +59,12 @@ Set/Get the type_constraint. =cut -sub type_constraint { +sub __type_constraint { my $self = shift @_; if(defined(my $tc = shift @_)) { - $self->{type_constraint} = $tc; + $self->{__type_constraint} = $tc; } - return $self->{type_constraint}; + return $self->{__type_constraint}; } =head2 isa @@ -74,8 +76,7 @@ handle $self->isa since AUTOLOAD can't. sub isa { my ($self, $target) = @_; if(defined $target) { - my $isa = $self->type_constraint->isa($target); - return $isa; + return $self->__type_constraint->isa($target); } else { return; } @@ -90,8 +91,7 @@ handle $self->can since AUTOLOAD can't. sub can { my ($self, $target) = @_; if(defined $target) { - my $can = $self->type_constraint->can($target); - return $can; + return $self->__type_constraint->can($target); } else { return; } @@ -114,8 +114,13 @@ Delegate to the decorator targe =cut 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 diff --git a/t/13_typedecorator.t b/t/13_typedecorator.t index cc600f4..89cc3a2 100644 --- a/t/13_typedecorator.t +++ b/t/13_typedecorator.t @@ -26,7 +26,10 @@ use lib "$FindBin::Bin/lib"; has 'StrOrArrayRef' => (is=>'rw', isa=>StrOrArrayRef); has 'AtLeastOneInt' => (is=>'rw', isa=>AtLeastOneInt); has 'pipeoverloading' => (is=>'rw', isa=>Int|Str); - has 'deep' => (is=>'rw', isa=>ArrayRef([ArrayRef([HashRef([Int])])])); + #has 'deep' => (is=>'rw', isa=>ArrayRef([ArrayRef([HashRef([Int])])])); + + has 'deep' => (is=>'rw', isa=>ArrayRef[ArrayRef[HashRef[Int]]] ); + } ## Make sure we have a 'create object sanity check' diff --git a/t/lib/DecoratorLibrary.pm b/t/lib/DecoratorLibrary.pm index 6ded368..9eee6ff 100644 --- a/t/lib/DecoratorLibrary.pm +++ b/t/lib/DecoratorLibrary.pm @@ -1,8 +1,5 @@ package DecoratorLibrary; -use warnings; -use strict; - use MooseX::Types::Moose qw( Str ArrayRef HashRef Int ); use MooseX::Types -declare => [qw( @@ -15,6 +12,21 @@ use MooseX::Types AtLeastOneInt )]; +## Some questionable messing around + sub my_subtype { + my ($subtype, $basetype, @rest) = @_; + return subtype($subtype, $basetype, shift @rest, shift @rest); + } + + sub my_from { + return @_; + + } + sub my_as { + return @_; + } +## End + subtype MyArrayRefBase, as ArrayRef; @@ -48,17 +60,19 @@ coerce MyArrayRefInt02, from MyHashRefOfStr, via {[ sort map { length $_ } values(%$_) ]}, ## Can't do HashRef[ArrayRef] here since if I do HashRef get the via {} - ## Stuff passed as args. - from HashRef([ArrayRef]), + ## Stuff passed as args and the associated prototype messed with it. MST + ## seems to have a line on it but might not fix fixable. + from (HashRef[ArrayRef]), via {[ sort map { @$_ } values(%$_) ]}; subtype StrOrArrayRef, as Str|ArrayRef; - + subtype AtLeastOneInt, ## Same problem as MyArrayRefInt02, see above. Another way to solve it by ## forcing some sort of context. Tried to fix this with method prototypes ## but just couldn't make it work. as (ArrayRef[Int]), where { @$_ > 0 }; + 1;