RT #74346

diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm
index be5d706..e7483cf 100644 (file)
--- a/lib/MooseX/Types/Common/String.pm
+++ b/lib/MooseX/Types/Common/String.pm
@@ -8,6 +8,7 @@ our $VERSION = '0.001004';
 use MooseX::Types -declare => [
   qw(SimpleStr
      NonEmptySimpleStr
+     NumericCode
      LowerCaseSimpleStr
      UpperCaseSimpleStr
      Password
@@ -43,6 +44,18 @@ subtype NonEmptySimpleStr,
         : ()
     );
 
+subtype NumericCode,
+  as NonEmptySimpleStr,
+  where { $_ =~ m/^[0-9]+$/ },
+  message {
+    'Must be a non-empty single line of no more than 255 chars that consists '
+       . 'of numeric characters only'
+  };
+
+coerce NumericCode,
+  from NonEmptySimpleStr,
+  via { my $code = $_; $code =~ s/[[:punct:]]//g; return $code };
+
 subtype Password,
   as NonEmptySimpleStr,
   where { length($_) > 3 },
@@ -203,6 +216,13 @@ A coercion exists via C<uc> from NonEmptyStr
 
 =back
 
+=item * NumericCode
+
+A Str with no new-line characters that consists of only Numeric characters.
+Examples include, Social Security Numbers, PINs, Postal Codes, HTTP Status
+Codes, etc. Supports attempting to coerce from a string that has punctuation
+in it ( e.g credit card number 4111-1111-1111-1111 ).
+
 =head1 SEE ALSO
 
 =over

diff --git a/t/01-string.t b/t/01-string.t
index 611a84a..d29ef2b 100644 (file)
--- a/t/01-string.t
+++ b/t/01-string.t
@@ -2,8 +2,9 @@
 
 use strict;
 use warnings;
-use Test::More tests => 22;
+use Test::More tests => 25;
 use Test::Fatal;
+use Test::Exception;
 
 {
   package FooTest;
@@ -17,7 +18,9 @@ use Test::Fatal;
        StrongPassword
        NonEmptyStr
        LowerCaseStr
-       UpperCaseStr),
+       UpperCaseStr
+       NumericCode
+       ),
   );
 
   has simplestr => ( is => 'rw', isa => SimpleStr );
@@ -29,6 +32,7 @@ use Test::Fatal;
   has strongpassword => ( is => 'rw', isa => StrongPassword );
   has lowercasestr => ( is => 'rw', isa => LowerCaseStr );
   has uppercasestr => ( is => 'rw', isa => UpperCaseStr );
+  has numericcode => ( is => 'rw', isa => NumericCode );
 }
 
 my $ins = FooTest->new;
@@ -63,3 +67,8 @@ is(exception { $ins->lowercasestr('ok') }, undef, 'LowerCaseStr 2');
 
 isnt(exception { $ins->uppercasestr('notok') }, undef, 'UpperCaseStr');
 is(exception { $ins->uppercasestr('OK') }, undef, 'UpperCaseStr 2');
+
+
+is(   exception { $ins->numericcode('032') }, undef,  'NumericCode lives');
+isnt( exception { $ins->numericcode('abc') }, undef,  'NumericCode dies' );
+isnt( exception { $ins->numericcode('x18') }, undef,  'mixed NumericCode dies');

diff --git a/t/04-coerce.t b/t/04-coerce.t
index 4ad1f98..b454a7b 100644 (file)
--- a/t/04-coerce.t
+++ b/t/04-coerce.t
@@ -2,17 +2,24 @@
 
 use strict;
 use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
 
 {
   package FooTest;
   use Moose;
-  use MooseX::Types::Common::String ( qw( LowerCaseSimpleStr UpperCaseSimpleStr LowerCaseStr UpperCaseStr) );
+  use MooseX::Types::Common::String ( qw(
+    LowerCaseSimpleStr
+    UpperCaseSimpleStr
+    LowerCaseStr
+    UpperCaseStr
+       NumericCode
+  ) );
 
   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 );
+  has numericcode  => ( is => 'rw', isa => NumericCode,  coerce => 1 );
 }
 
 my $ins = FooTest->new({
@@ -20,6 +27,7 @@ my $ins = FooTest->new({
   lowercasesimplestr => 'BAR',
   uppercasestr => 'foo',
   lowercasestr => 'BAR',
+  numericcode  => '4111-1111-1111-1111',
 });
 
 is( $ins->uppercasesimplestr, 'FOO', 'uppercase str' );
@@ -27,3 +35,5 @@ is( $ins->lowercasesimplestr, 'bar', 'lowercase str' );
 
 is( $ins->uppercasestr, 'FOO', 'uppercase str' );
 is( $ins->lowercasestr, 'bar', 'lowercase str' );
+
+is( $ins->numericcode, '4111111111111111', 'numeric code' );