Bug #71133 for MooseX-Types-Common: [PATCH] add UpperCaseStr and LowerCaseStr types

often times codes are upper case only strings. So I've added this and a complimentary lower case only string. includes tests, and documentation Signed-off-by: Caleb Cushing <xenoterracide@gmail.com> --- lib/MooseX/Types/Common/String.pm | 48 +++++++++++++++++++++++++++++++++---- t/01-string.t | 22 ++++++++++++++--- t/04-coerce.t | 25 +++++++++++++++++++ 3 files changed, 86 insertions(+), 9 deletions(-) create mode 100644 t/04-coerce.t diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm index add28aa..8d8b3ab 100644 --- a/lib/MooseX/Types/Common/String.pm +++ b/lib/MooseX/Types/Common/String.pm @@ -3,11 +3,17 @@ package MooseX::Types::Common::String; use strict; use warnings; -our $VERSION = '0.001001'; - -use MooseX::Types -declare => [ - qw(SimpleStr NonEmptySimpleStr Password StrongPassword NonEmptyStr) -]; +our $VERSION = '0.001004'; + +use MooseX::Types -declare => [ qw( + SimpleStr + NonEmptySimpleStr + Password + StrongPassword + NonEmptyStr + LowerCaseStr + UpperCaseStr +)]; use MooseX::Types::Moose qw/Str/; @@ -72,6 +78,29 @@ subtype NonEmptyStr, : () ); +subtype UpperCaseStr, + as NonEmptySimpleStr, + where { $_ =~ m/^[A-Z]*$/xms }, + message{ 'must only contain upper case characters' }, + ; + +coerce UpperCaseStr, + from Str, + via { + return uc $_; + }; + +subtype LowerCaseStr, + as NonEmptySimpleStr, + where { $_ =~ m/^[a-z]*$/xms }, + message{ 'must only contain lower case characters' }, + ; + +coerce LowerCaseStr, + from Str, + via { + return lc $_; + }; 1; @@ -109,6 +138,15 @@ Does what it says on the tin. =item * NonEmptyStr +=item * LowerCaseStr + +Non Empty String that contains only lower case characters. Coerce will attempt +to coerce with C<lc>. + +=item * UpperCaseStr + +See LowerCaseStr, but upper case. + =back =head1 SEE ALSO diff --git a/t/01-string.t b/t/01-string.t index 7632b70..5ad7b9b 100644 --- a/t/01-string.t +++ b/t/01-string.t @@ -2,21 +2,29 @@ use strict; use warnings; -use Test::More tests => 14; +use Test::More tests => 18; use Test::Exception; { package FooTest; use Moose; - use MooseX::Types::Common::String ( - qw(SimpleStr NonEmptySimpleStr Password StrongPassword NonEmptyStr), - ); + use MooseX::Types::Common::String (qw( + SimpleStr + NonEmptySimpleStr + 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 uppercasestr => ( is => 'rw', isa => UpperCaseStr ); + has lowercasestr => ( is => 'rw', isa => LowerCaseStr ); } my $ins = FooTest->new; @@ -39,3 +47,9 @@ lives_ok { $ins->password('okay') } 'Password 2'; dies_ok { $ins->strongpassword('notokay') } 'StrongPassword'; lives_ok { $ins->strongpassword('83773r_ch01c3') } 'StrongPassword 2'; + +dies_ok { $ins->uppercasestr('notok') } 'UpperCaseStr'; +lives_ok { $ins->uppercasestr('OK') } 'UpperCaseStr 2'; + +dies_ok { $ins->lowercasestr('NOTOK') } 'LowerCaseStr'; +lives_ok { $ins->lowercasestr('ok') } 'LowerCaseStr 2'; diff --git a/t/04-coerce.t b/t/04-coerce.t new file mode 100644 index 0000000..c3b92fc --- /dev/null +++ b/t/04-coerce.t @@ -0,0 +1,25 @@ +#! /usr/bin/perl -w + +use strict; +use warnings; +use Test::More tests => 2; + +{ + package FooTest; + use Moose; + use MooseX::Types::Common::String (qw( + LowerCaseStr + UpperCaseStr + ),); + + has uppercasestr => ( is => 'rw', isa => UpperCaseStr, coerce => 1 ); + has lowercasestr => ( is => 'rw', isa => LowerCaseStr, coerce => 1 ); +} + +my $ins = FooTest->new({ + uppercasestr => 'foo', + lowercasestr => 'BAR', +}); + +is( $ins->uppercasestr, 'FOO', 'uppercase str' ); +is( $ins->lowercasestr, 'bar', 'lowercase str' ); -- 1.7.6.1