From: John Napiorkowski Date: Thu, 24 Jun 2010 18:30:50 +0000 (-0400) Subject: maybe a more concise synopsis X-Git-Tag: 0.02~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1fa2711689a9544c68dd3a718135fcc53c43a163;hp=3ad84652b4e9df919b8dc5444be0aca986273fe9;p=gitmo%2FMooseX-Dependent.git maybe a more concise synopsis --- diff --git a/lib/MooseX/Types/Parameterizable.pm b/lib/MooseX/Types/Parameterizable.pm index 18e3951..861773b 100644 --- a/lib/MooseX/Types/Parameterizable.pm +++ b/lib/MooseX/Types/Parameterizable.pm @@ -15,47 +15,40 @@ MooseX::Types::Parameterizable - Create your own Parameterizable Types. =head1 SYNOPSIS -Within your L declared library module: +The follow is example usage. - use Set::Scalar; + use Moose; use MooseX::Types::Parameterizable qw(Parameterizable); - use MooseX::Types::Moose qw(Int ); - use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet)]; - - subtype Set, - as class_type("Set::Scalar"); - - subtype UniqueInt, - as Parameterizable[Int, Set], - where { - my ($int, $set) = @_; - return !$set->has($int); - }; - - subtype PositiveSet, - as Set, - where { - my ($set) = @_; - return !grep {$_ <0 } $set->members; - }; - - subtype PositiveUniqueInt, - as UniqueInt[PositiveSet]; - - my $set = Set::Scalar->new(1,2,3); + use MooseX::Types::Moose qw(Str Int); + use MooseX::Types -declare=>[qw(Varchar)]; - UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) - UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) - UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) - - PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) - PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int - PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) - - my $negative_set = Set::Scalar->new(-1,-2,-3); - - UniqueInt([$negative_set])->check(100); ## Throws exception - + subtype Varchar, + as Parameterizable[Str,Int], + where { + my($string, $int) = @_; + $int >= length($string) ? 1:0; + }, + message { + "'$_' is too long" + }; + + has varchar_five => (isa=>Varchar[5], is=>'ro'); + has varchar_ten => (isa=>Varchar[10], is=>'ro'); + + ## This works fine + my $object1 = __PACKAGE__->new( + varchar_five => '1234', + varchar_ten => '123456789', + ); + + ## This explodes with a type constraint error + my $object2 = __PACKAGE__->new( + varchar_five => '12345678', ## Too long string + varchar_ten => '123456789', + ); + +See t/05-pod-examples.t for runnable versions of all POD code + =head1 DESCRIPTION A L library for creating parameterizable types. A parameterizable type diff --git a/t/05-pod-examples.t b/t/05-pod-examples.t new file mode 100644 index 0000000..061dcec --- /dev/null +++ b/t/05-pod-examples.t @@ -0,0 +1,146 @@ +use strict; +use warnings; + +use Test::More; + +eval "use Set::Scalar"; if($@) { + plan skip_all => 'Set::Scalar not installed'; +} + + +{ + package Test::MooseX::Types::Parameterizable::Synopsis; + + use Moose; + use MooseX::Types::Parameterizable qw(Parameterizable); + use MooseX::Types::Moose qw(Str Int); + use MooseX::Types -declare=>[qw(Varchar)]; + + subtype Varchar, + as Parameterizable[Str,Int], + where { + my($string, $int) = @_; + $int >= length($string) ? 1:0; + }, + message { "'$_' is too long" }; + + my $varchar_five = Varchar[5]; + + Test::More::ok $varchar_five->check('four'); + Test::More::ok ! $varchar_five->check('verylongstrong'); + + my $varchar_ten = Varchar[10]; + + Test::More::ok $varchar_ten->check( 'X' x 9 ); + Test::More::ok ! $varchar_ten->check( 'X' x 12 ); + + has varchar_five => (isa=>Varchar[5], is=>'ro'); + has varchar_ten => (isa=>Varchar[10], is=>'ro'); + + my $object1 = __PACKAGE__->new( + varchar_five => '1234', + varchar_ten => '123456789', + ); + + eval { + my $object2 = __PACKAGE__->new( + varchar_five => '12345678', + varchar_ten => '123456789', + ); + }; + + Test::More::ok $@, 'There was an error'; + Test::More::like $@, qr('12345678' is too long), 'Correct custom error'; +} + +done_testing; + + +__END__ + +use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )]; + +subtype Set, + as class_type("Set::Scalar"); + +subtype UniqueInt, + as Parameterizable[Int, Set], + where { + my ($int, $set) = @_; + !$set->has($int); + }; + +subtype PositiveSet, + as Set, + where { + my ($set) = @_; + ! grep { $_ < 0 } $set->members; + }; + +subtype PositiveUniqueInt, + as UniqueInt[PositiveSet]; + +my $set = Set::Scalar->new(-1,-2,1,2,3); +my $positive_set = Set::Scalar->new(1,2,3); +my $negative_set = Set::Scalar->new(-1,-2,-3); + +ok Set->check($set), + 'Is a Set'; + +ok Set->check($positive_set), + 'Is a Set'; + +ok Set->check($negative_set), + 'Is a Set'; + +ok !PositiveSet->check($set), + 'Is Not a Positive Set'; + +ok PositiveSet->check($positive_set), + 'Is a Positive Set'; + +ok !PositiveSet->check($negative_set), + 'Is Not a Positive Set'; + +ok UniqueInt([$set])->check(100), + '100 not in Set'; + +ok UniqueInt([$positive_set])->check(100), + '100 not in Set'; + +ok UniqueInt([$negative_set])->check(100), + '100 not in Set'; + +ok UniqueInt([$set])->check(-99), + '-99 not in Set'; + +ok UniqueInt([$positive_set])->check(-99), + '-99 not in Set'; + +ok UniqueInt([$negative_set])->check(-99), + '-99 not in Set'; + +ok !UniqueInt([$set])->check(2), + '2 in Set'; + +ok !UniqueInt([$positive_set])->check(2), + '2 in Set'; + +ok UniqueInt([$negative_set])->check(2), + '2 not in Set'; + + +__END__ + +ok UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) +ok UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) +ok !UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) + +ok PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) +ok !PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int +ok !PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) + +my $negative_set = Set::Scalar->new(-1,-2,-3); + +ok UniqueInt([$negative_set])->check(100); ## Throws exception +