X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FCommon%2FString.pm;h=a9ccd6fefc65561f50ea7ef547728666f2438905;hb=31633b2663f3f18784c3356360339b919e64846c;hp=add28aacb28bae86d443e6784d43a382d276e018;hpb=d2461fdae3ea97b18a2b85487bb46cfc1934aa87;p=gitmo%2FMooseX-Types-Common.git diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm index add28aa..a9ccd6f 100644 --- a/lib/MooseX/Types/Common/String.pm +++ b/lib/MooseX/Types/Common/String.pm @@ -3,10 +3,19 @@ package MooseX::Types::Common::String; use strict; use warnings; -our $VERSION = '0.001001'; +our $VERSION = '0.001005'; use MooseX::Types -declare => [ - qw(SimpleStr NonEmptySimpleStr Password StrongPassword NonEmptyStr) + qw(SimpleStr + NonEmptySimpleStr + NumericCode + LowerCaseSimpleStr + UpperCaseSimpleStr + Password + StrongPassword + NonEmptyStr + LowerCaseStr + UpperCaseStr) ]; use MooseX::Types::Moose qw/Str/; @@ -35,7 +44,18 @@ subtype NonEmptySimpleStr, : () ); -# XXX duplicating constraint msges since moose only uses last message +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 }, @@ -72,6 +92,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 +184,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,8 +202,27 @@ 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 +=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