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 (file)
--- 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<lc> from NonEmptySimpleStr
+
+=item * UpperCaseSimpleStr
+
+A Str with no new-line characters, length > 0 and all uppercase characters
+A coercion exists via C<uc> 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<lc> from NonEmptyStr
+
+=item * UpperCaseStr
+
+A Str with length > 0 and all uppercase characters.
+A coercion exists via C<uc> from NonEmptyStr
+
 =back
 
 =head1 SEE ALSO

diff --git a/t/01-string.t b/t/01-string.t
index 083f783..611a84a 100644 (file)
--- 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 (file)
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' );