From: Justin Hunter Date: Tue, 6 Dec 2011 04:27:58 +0000 (-0500) Subject: add upper/lowercase for SimpleStr and Str X-Git-Tag: 0.001004~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Common.git;a=commitdiff_plain;h=a5c9a43331cadecc264704887a3ef1b4ad4c7f0e add upper/lowercase for SimpleStr and Str --- diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm index 0b27750..fe4edf8 100644 --- a/lib/MooseX/Types/Common/String.pm +++ b/lib/MooseX/Types/Common/String.pm @@ -6,7 +6,15 @@ use warnings; our $VERSION = '0.001003'; use MooseX::Types -declare => [ - qw(SimpleStr NonEmptySimpleStr Password StrongPassword NonEmptyStr) + qw(SimpleStr + NonEmptySimpleStr + LowerCaseSimpleStr + UpperCaseSimpleStr + Password + StrongPassword + NonEmptyStr + LowerCaseStr + UpperCaseStr) ]; use MooseX::Types::Moose qw/Str/; @@ -35,7 +43,6 @@ subtype NonEmptySimpleStr, : () ); -# XXX duplicating constraint msges since moose only uses last message subtype Password, as NonEmptySimpleStr, where { length($_) > 3 }, @@ -72,6 +79,69 @@ subtype NonEmptyStr, : () ); +subtype LowerCaseStr, + as NonEmptyStr, + where { /^[a-z]+$/xms }, + message { "Must only contain lower case letters" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( $_[1] =~ m/^[a-z]+\$/xms ) }; + } + : () + ); + +coerce LowerCaseStr, + from NonEmptyStr, + via { lc }; + +subtype UpperCaseStr, + as NonEmptyStr, + where { /^[A-Z]+$/xms }, + message { "Must only contain upper case letters" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( $_[1] =~ m/^[A-Z]+\$/xms ) }; + } + : () + ); + +coerce UpperCaseStr, + from NonEmptyStr, + via { uc }; + +subtype LowerCaseSimpleStr, + as NonEmptySimpleStr, + where { /^[a-z]+$/x }, + message { "Must only contain lower case letters" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( $_[1] =~ m/^[a-z]+\$/x ) }; + } + : () + ); + +coerce LowerCaseSimpleStr, + from NonEmptySimpleStr, + via { lc }; + +subtype UpperCaseSimpleStr, + as NonEmptySimpleStr, + where { /^[A-Z]+$/x }, + message { "Must only contain upper case letters" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( $_[1] =~ m/^[A-Z]+\$/x ) }; + } + : () + ); + +coerce UpperCaseSimpleStr, + from NonEmptySimpleStr, + via { uc }; 1; @@ -101,7 +171,17 @@ A Str with no new-line characters. =item * NonEmptySimpleStr -Does what it says on the tin. +A Str with no new-line characters and length > 0 + +=item * LowerCaseSimpleStr + +A Str with no new-line characters, length > 0 and all lowercase characters +A coercion exists via C from NonEmptySimpleStr + +=item * UpperCaseSimpleStr + +A Str with no new-line characters, length > 0 and all uppercase characters +A coercion exists via C from NonEmptySimpleStr =item * Password @@ -109,6 +189,18 @@ Does what it says on the tin. =item * NonEmptyStr +A Str with length > 0 + +=item * LowerCaseStr + +A Str with length > 0 and all lowercase characters. +A coercion exists via C from NonEmptyStr + +=item * UpperCaseStr + +A Str with length > 0 and all uppercase characters. +A coercion exists via C from NonEmptyStr + =back =head1 SEE ALSO diff --git a/t/01-string.t b/t/01-string.t index 083f783..611a84a 100644 --- a/t/01-string.t +++ b/t/01-string.t @@ -2,21 +2,33 @@ use strict; use warnings; -use Test::More tests => 14; +use Test::More tests => 22; use Test::Fatal; { package FooTest; use Moose; use MooseX::Types::Common::String ( - qw(SimpleStr NonEmptySimpleStr Password StrongPassword NonEmptyStr), + qw(SimpleStr + NonEmptySimpleStr + LowerCaseSimpleStr + UpperCaseSimpleStr + Password + StrongPassword + NonEmptyStr + LowerCaseStr + UpperCaseStr), ); - has simplestr => ( is => 'rw', isa => SimpleStr); - has nestr => ( is => 'rw', isa => NonEmptyStr); - has nesimplestr => ( is => 'rw', isa => NonEmptySimpleStr); - has password => ( is => 'rw', isa => Password); - has strongpassword => ( is => 'rw', isa => StrongPassword); + has simplestr => ( is => 'rw', isa => SimpleStr ); + has nestr => ( is => 'rw', isa => NonEmptyStr ); + has nesimplestr => ( is => 'rw', isa => NonEmptySimpleStr ); + has lcsimplestr => ( is => 'rw', isa => LowerCaseSimpleStr ); + has ucsimplestr => ( is => 'rw', isa => UpperCaseSimpleStr ); + has password => ( is => 'rw', isa => Password ); + has strongpassword => ( is => 'rw', isa => StrongPassword ); + has lowercasestr => ( is => 'rw', isa => LowerCaseStr ); + has uppercasestr => ( is => 'rw', isa => UpperCaseStr ); } my $ins = FooTest->new; @@ -39,3 +51,15 @@ is(exception { $ins->password('okay') }, undef, 'Password 2'); isnt(exception { $ins->strongpassword('notokay') }, undef, 'StrongPassword'); is(exception { $ins->strongpassword('83773r_ch01c3') }, undef, 'StrongPassword 2'); + +isnt(exception { $ins->lcsimplestr('NOTOK') }, undef, 'LowerCaseSimpleStr'); +is(exception { $ins->lcsimplestr('ok') }, undef, 'LowerCaseSimpleStr 2'); + +isnt(exception { $ins->ucsimplestr('notok') }, undef, 'UpperCaseSimpleStr'); +is(exception { $ins->ucsimplestr('OK') }, undef, 'UpperCaseSimpleStr 2'); + +isnt(exception { $ins->lowercasestr('NOTOK') }, undef, 'LowerCaseStr'); +is(exception { $ins->lowercasestr('ok') }, undef, 'LowerCaseStr 2'); + +isnt(exception { $ins->uppercasestr('notok') }, undef, 'UpperCaseStr'); +is(exception { $ins->uppercasestr('OK') }, undef, 'UpperCaseStr 2'); diff --git a/t/04-coerce.t b/t/04-coerce.t new file mode 100644 index 0000000..4ad1f98 --- /dev/null +++ b/t/04-coerce.t @@ -0,0 +1,29 @@ +#! /usr/bin/perl -w + +use strict; +use warnings; +use Test::More tests => 4; + +{ + package FooTest; + use Moose; + use MooseX::Types::Common::String ( qw( LowerCaseSimpleStr UpperCaseSimpleStr LowerCaseStr UpperCaseStr) ); + + has uppercasesimplestr => ( is => 'rw', isa => UpperCaseSimpleStr, coerce => 1 ); + has lowercasesimplestr => ( is => 'rw', isa => LowerCaseSimpleStr, coerce => 1 ); + has uppercasestr => ( is => 'rw', isa => UpperCaseStr, coerce => 1 ); + has lowercasestr => ( is => 'rw', isa => LowerCaseStr, coerce => 1 ); +} + +my $ins = FooTest->new({ + uppercasesimplestr => 'foo', + lowercasesimplestr => 'BAR', + uppercasestr => 'foo', + lowercasestr => 'BAR', +}); + +is( $ins->uppercasesimplestr, 'FOO', 'uppercase str' ); +is( $ins->lowercasesimplestr, 'bar', 'lowercase str' ); + +is( $ins->uppercasestr, 'FOO', 'uppercase str' ); +is( $ins->lowercasestr, 'bar', 'lowercase str' );