-0.05 ...
+0.06 Fri Sep 25 12:00:00 EST 2008
+ - Added support for parameterized types and type unions, tests for all
+ that and documentation updates.
+
+0.05 [Indetermined]
- moved export mechanism to Sub::Exporter. ::Base contains
a bunch of wrapping logic to allow the export-along functionality
for the helper symbols
author q{Robert 'phaylon' Sedlacek <rs@474.at>};
all_from q{lib/MooseX/Types.pm};
-build_requires q{Test::More}, 0.62;
+build_requires q{Test::More}, 0.80;
build_requires q{FindBin}, 0;
-requires q{Moose}, 0.24;
-requires q{Sub::Install}, 0.922;
-requires q{namespace::clean}, 0.04;
+requires q{Moose}, 0.60;
+requires q{Sub::Install}, 0.924;
+requires q{namespace::clean}, 0.08;
requires q{Carp}, 0;
-requires q{Carp::Clan}, 0;
-requires q{Class::MOP}, 0;
+requires q{Carp::Clan}, 6.00;
+requires q{Scalar::Util}, 1.19;
system 'pod2text lib/MooseX/Types.pm > README'
if -e 'MANIFEST.SKIP';
auto_provides;
-
auto_install;
-
WriteAll;
#use strict;
use Moose::Util::TypeConstraints;
+use MooseX::Types::TypeDecorator;
use MooseX::Types::Base ();
use MooseX::Types::Util qw( filter_tags );
use MooseX::Types::UndefinedType;
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'};
=head1 SYNOPSIS
# 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';
from Int,
via { 1 };
+ # with parameterized constraints.
+
+ 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
A message that will be thrown when type functionality is used but the
type does not yet exist.
-=back
+=head1 NOTES REGARDING TYPE UNIONS
+L<MooseX::Types> uses L<MooseX::Types::TypeDecorator> 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
=cut
sub type_export_generator {
- my ($class, $type, $full) = @_;
- return sub {
- return find_type_constraint($full)
- || MooseX::Types::UndefinedType->new($full);
+ my ($class, $type, $name) = @_;
+
+ ## Return an anonymous subroutine that will generate the proxied type
+ ## constraint for you.
+
+ return sub {
+ my $type_constraint;
+ if(defined(my $params = shift @_)) {
+ ## We currently only allow a TC to accept a single, ArrayRef
+ ## parameter, as in HashRef[Int], where [Int] is what's inside the
+ ## ArrayRef passed.
+ if(ref $params eq 'ARRAY') {
+ $type_constraint = $class->create_arged_type_constraint($name, @$params);
+ } else {
+ croak 'Arguments must be an ArrayRef, not '. ref $params;
+ }
+ } else {
+ $type_constraint = $class->create_base_type_constraint($name);
+ }
+ $type_constraint = defined($type_constraint) ? $type_constraint
+ : MooseX::Types::UndefinedType->new($name);
+
+ my $type_decorator = $class->create_type_decorator($type_constraint);
+
+ ## If there are additional args, that means it's probably stuff that
+ ## needs to be returned to the subtype. Not an ideal solution here but
+ ## doesn't seem to cause trouble.
+
+ if(@_) {
+ return ($type_decorator, @_);
+ } else {
+ return $type_decorator;
+ }
};
}
+=head2 create_arged_type_constraint ($name, @args)
+
+Given a String $name with @args find the matching typeconstraint and parameterize
+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");
+ return $type_constraint->parameterize(@args);
+}
+
+=head2 create_base_type_constraint ($name)
+
+Given a String $name, find the matching typeconstraint.
+
+=cut
+
+sub create_base_type_constraint {
+ my ($class, $name) = @_;
+ return find_type_constraint($name);
+}
+
+=head2 create_type_decorator ($type_constraint)
+
+Given a $type_constraint, return a lightweight L<MooseX::Types::TypeDecorator>
+instance.
+
+=cut
+
+sub create_type_decorator {
+ my ($class, $type_constraint) = @_;
+ return MooseX::Types::TypeDecorator->new($type_constraint);
+}
+
=head2 coercion_export_generator
This generates a coercion handler function, e.g. C<to_Int($value)>.
=head1 CAVEATS
+The following are lists of gotcha's and their workarounds for developers coming
+from the standard string based type constraint names
+
+=head2 Uniqueness
+
A library makes the types quasi-unique by prefixing their names with (by
default) the library package name. If you're only using the type handler
functions provided by MooseX::Types, you shouldn't ever have to use
a type's actual full name.
+=head2 Argument separation ('=>' versus ',')
+
+The Perlop manpage has this to say about the '=>' operator: "The => operator is
+a synonym for the comma, but forces any word (consisting entirely of word
+characters) to its left to be interpreted as a string (as of 5.001). This
+includes words that might otherwise be considered a constant or function call."
+
+Due to this stringification, the following will NOT work as you might think:
+
+ subtype StrOrArrayRef => as Str|ArrayRef;
+
+The 'StrOrArrayRef' will have it's stringification activated this causes the
+subtype to not be created. Since the bareword type constraints are not strings
+you really should not try to treat them that way. You will have to use the ','
+operator instead. The author's of this package realize that all the L<Moose>
+documention and examples nearly uniformly use the '=>' version of the comma
+operator and this could be an issue if you are converting code.
+
+Patches welcome for discussion.
+
=head1 SEE ALSO
L<Moose>,
Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
the C<#moose> cabal on C<irc.perl.org>.
+Additional features by John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org>.
+
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
--- /dev/null
+package MooseX::Types::TypeDecorator;
+
+use strict;
+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 {
+ return shift->__type_constraint->name;
+ },
+ '|' => sub {
+
+ ## It's kind of ugly that we need to know about Union Types, but this
+ ## is needed for syntax compatibility. Maybe someday we'll all just do
+ ## Or[Str,Str,Int]
+
+ my @tc = grep {blessed $_} @_;
+ my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
+ return Moose::Util::TypeConstraints::register_type_constraint($union);
+ },
+ fallback => 1,
+
+);
+
+
+=head1 NAME
+
+MooseX::Types::TypeDecorator - More flexible access to a Type Constraint
+
+=head1 DESCRIPTION
+
+This is a decorator object that contains an underlying type constraint. We use
+this to control access to the type constraint and to add some features.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 new
+
+Old school instantiation
+
+=cut
+
+sub new {
+ my $class = shift @_;
+ if(my $arg = shift @_) {
+ if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
+ return bless {'__type_constraint'=>$arg}, $class;
+ } 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(blessed $arg) {
+ croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg;
+ } else {
+ croak "Argument cannot be '$arg'";
+ }
+ } else {
+ croak "This method [new] requires a single argument of 'arg'.";
+ }
+}
+
+=head __type_constraint ($type_constraint)
+
+Set/Get the type_constraint.
+
+=cut
+
+sub __type_constraint {
+ my $self = shift @_;
+
+ 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';
+ }
+}
+
+=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;
+ }
+}
+
+=head2 DESTROY
+
+We might need it later
+
+=cut
+
+sub DESTROY {
+ return;
+}
+
+=head2 AUTOLOAD
+
+Delegate to the decorator targe
+
+=cut
+
+sub AUTOLOAD {
+ my ($self, @args) = @_;
+ my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
+ if($self->__type_constraint->can($method)) {
+ return $self->__type_constraint->$method(@args);
+ } else {
+ croak "Method '$method' is not supported";
+ }
+}
+
+=head1 AUTHOR AND COPYRIGHT
+
+John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use Test::More tests => 49;
+use Test::Exception;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+{
+ package Test::MooseX::TypeLibrary::TypeDecorator;
+
+ use Moose;
+ use MooseX::Types::Moose qw(
+ Int Str ArrayRef HashRef Object
+ );
+ use DecoratorLibrary qw(
+ MyArrayRefBase MyArrayRefInt01 MyArrayRefInt02 StrOrArrayRef
+ AtLeastOneInt Jobs
+ );
+
+ has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
+ has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
+ has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1);
+ has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]);
+ 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 'deep2' => (is=>'rw', isa=>ArrayRef[Int|ArrayRef[HashRef[Int|Object]]] );
+ has 'enum' => (is=>'rw', isa=>Jobs);
+}
+
+## Make sure we have a 'create object sanity check'
+
+ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(),
+ => 'Created some sort of object';
+
+isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
+ => "Yes, it's the correct kind of object";
+
+## test arrayrefbase normal and coercion
+
+ok $type->arrayrefbase([qw(a b c d e)])
+ => 'Assigned arrayrefbase qw(a b c d e)';
+
+is_deeply $type->arrayrefbase, [qw(a b c d e)],
+ => 'Assignment is correct';
+
+ok $type->arrayrefbase('d,e,f')
+ => 'Assignment arrayrefbase d,e,f to test coercion';
+
+is_deeply $type->arrayrefbase, [qw(d e f)],
+ => 'Assignment and coercion is correct';
+
+## test arrayrefint01 normal and coercion
+
+ok $type->arrayrefint01([qw(1 2 3)])
+ => 'Assignment arrayrefint01 qw(1 2 3)';
+
+is_deeply $type->arrayrefint01, [qw(1 2 3)],
+ => 'Assignment is correct';
+
+ok $type->arrayrefint01('4.5.6')
+ => 'Assigned arrayrefint01 4.5.6 to test coercion from Str';
+
+is_deeply $type->arrayrefint01, [qw(4 5 6)],
+ => 'Assignment and coercion is correct';
+
+ok $type->arrayrefint01({a=>7,b=>8})
+ => 'Assigned arrayrefint01 {a=>7,b=>8} to test coercion from HashRef';
+
+is_deeply $type->arrayrefint01, [qw(7 8)],
+ => 'Assignment and coercion is correct';
+
+throws_ok sub {
+ $type->arrayrefint01([qw(a b c)])
+}, qr/Attribute \(arrayrefint01\) does not pass the type constraint/ => 'Dies when values are strings';
+
+## test arrayrefint02 normal and coercion
+
+ok $type->arrayrefint02([qw(1 2 3)])
+ => 'Assigned arrayrefint02 qw(1 2 3)';
+
+is_deeply $type->arrayrefint02, [qw(1 2 3)],
+ => 'Assignment is correct';
+
+ok $type->arrayrefint02('4:5:6')
+ => 'Assigned arrayrefint02 4:5:6 to test coercion from Str';
+
+is_deeply $type->arrayrefint02, [qw(4 5 6)],
+ => 'Assignment and coercion is correct';
+
+ok $type->arrayrefint02({a=>7,b=>8})
+ => 'Assigned arrayrefint02 {a=>7,b=>8} to test coercion from HashRef';
+
+is_deeply $type->arrayrefint02, [qw(7 8)],
+ => 'Assignment and coercion is correct';
+
+ok $type->arrayrefint02({a=>'AA',b=>'BBB', c=>'CCCCCCC'})
+ => "Assigned arrayrefint02 {a=>'AA',b=>'BBB', c=>'CCCCCCC'} to test coercion from HashRef";
+
+is_deeply $type->arrayrefint02, [qw(2 3 7)],
+ => 'Assignment and coercion is correct';
+
+ok $type->arrayrefint02({a=>[1,2],b=>[3,4]})
+ => "Assigned arrayrefint02 {a=>[1,2],b=>[3,4]} to test coercion from HashRef";
+
+is_deeply $type->arrayrefint02, [qw(1 2 3 4)],
+ => 'Assignment and coercion is correct';
+
+# test arrayrefint03
+
+ok $type->arrayrefint03([qw(11 12 13)])
+ => 'Assigned arrayrefint01 qw(11 12 13)';
+
+is_deeply $type->arrayrefint03, [qw(11 12 13)],
+ => 'Assignment is correct';
+
+throws_ok sub {
+ $type->arrayrefint03([qw(a b c)])
+}, qr/Attribute \(arrayrefint03\) does not pass the type constraint/ => 'Dies when values are strings';
+
+# TEST StrOrArrayRef
+
+ok $type->StrOrArrayRef('string')
+ => 'String part of union is good';
+
+ok $type->StrOrArrayRef([1,2,3])
+ => 'arrayref part of union is good';
+
+throws_ok sub {
+ $type->StrOrArrayRef({a=>111});
+}, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
+
+# Test AtLeastOneInt
+
+ok $type->AtLeastOneInt([1,2]),
+ => 'Good assignment';
+
+is_deeply $type->AtLeastOneInt, [1,2]
+ => "Got expected values.";
+
+throws_ok sub {
+ $type->AtLeastOneInt([]);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails to assign as []';
+
+throws_ok sub {
+ $type->AtLeastOneInt(['a','b']);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails arrayref of strings';
+
+## Test pipeoverloading
+
+ok $type->pipeoverloading(1)
+ => 'Integer for union test accepted';
+
+ok $type->pipeoverloading('a')
+ => 'String for union test accepted';
+
+throws_ok sub {
+ $type->pipeoverloading({a=>1,b=>2});
+}, qr/Validation failed for 'Int|Str'/ => 'Union test corrected fails a HashRef';
+
+## test deep (ArrayRef[ArrayRef[HashRef[Int]]])
+
+ok $type->deep([[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]])
+ => 'Assigned deep to [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]';
+
+is_deeply $type->deep, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]],
+ => 'Assignment is correct';
+
+throws_ok sub {
+ $type->deep({a=>1,b=>2});
+}, qr/Attribute \(deep\) does not pass the type constraint/ => 'Deep Constraints properly fail';
+
+# test deep2 (ArrayRef[Int|ArrayRef[HashRef[Int|Object]]])
+
+ok $type->deep2([[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]])
+ => 'Assigned deep2 to [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]';
+
+is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]],
+ => 'Assignment is correct';
+
+throws_ok sub {
+ $type->deep2({a=>1,b=>2});
+}, qr/Attribute \(deep2\) does not pass the type constraint/ => 'Deep Constraints properly fail';
+
+throws_ok sub {
+ $type->deep2([[{a=>1,b=>2},{c=>3,d=>'noway'}],[{e=>5}]]);
+}, qr/Attribute \(deep2\) does not pass the type constraint/ => 'Deep Constraints properly fail';
+
+
+ok $type->deep2([[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]])
+ => 'Assigned deep2 to [[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]]';
+
+
+is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]],
+ => 'Assignment is correct';
+
+ok $type->deep2([1,2,3])
+ => 'Assigned deep2 to [1,2,3]';
+
+
+is_deeply $type->deep2, [1,2,3],
+ => 'Assignment is correct';
+
+## Test jobs
+
+ok $type->enum('Programming')
+ => 'Good Assignment of Programming to Enum';
+
+
+throws_ok sub {
+ $type->enum('ddddd');
+}, qr/Attribute \(enum\) does not pass the type constraint/ => 'Enum properly fails';
--- /dev/null
+package DecoratorLibrary;
+
+use MooseX::Types::Moose qw( Str ArrayRef HashRef Int );
+use MooseX::Types
+ -declare => [qw(
+ MyArrayRefBase
+ MyArrayRefInt01
+ MyArrayRefInt02
+ MyHashRefOfInts
+ MyHashRefOfStr
+ StrOrArrayRef
+ AtLeastOneInt
+ Jobs
+ )];
+
+## 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;
+
+coerce MyArrayRefBase,
+ from Str,
+ via {[split(',', $_)]};
+
+subtype MyArrayRefInt01,
+ as ArrayRef[Int];
+
+coerce MyArrayRefInt01,
+ from Str,
+ via {[split('\.',$_)]},
+ from HashRef,
+ via {[sort values(%$_)]};
+
+subtype MyArrayRefInt02,
+ as MyArrayRefBase[Int];
+
+subtype MyHashRefOfInts,
+ as HashRef[Int];
+
+subtype MyHashRefOfStr,
+ as HashRef[Str];
+
+coerce MyArrayRefInt02,
+ from Str,
+ via {[split(':',$_)]},
+ from MyHashRefOfInts,
+ via {[sort values(%$_)]},
+ from MyHashRefOfStr,
+ via {[ sort map { length $_ } values(%$_) ]},
+ from HashRef[ArrayRef],
+ via {[ sort map { @$_ } values(%$_) ]};
+
+subtype StrOrArrayRef,
+ as Str|ArrayRef;
+
+subtype AtLeastOneInt,
+ as ArrayRef[Int],
+ where { @$_ > 0 };
+
+enum Jobs,
+ (qw/Programming Teaching Banking/);
+
+1;
projects / gitmo/MooseX-Types.git / commitdiff