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=7e6a8314fed6e2e342614338a0102989b6fc8f65;hpb=6820e93974f7ea696fb5340f01e6f4e676fdd4b0;p=gitmo%2FMooseX-Types-Common.git diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm index 7e6a831..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/; @@ -14,29 +23,138 @@ use MooseX::Types::Moose qw/Str/; subtype SimpleStr, as Str, where { (length($_) <= 255) && ($_ !~ m/\n/) }, - message { "Must be a single line of no more than 255 chars" }; + message { "Must be a single line of no more than 255 chars" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( (length($_[1]) <= 255) && ($_[1] !~ m/\n/) ) }; + } + : () + ); subtype NonEmptySimpleStr, as SimpleStr, where { length($_) > 0 }, - message { "Must be a non-empty single line of no more than 255 chars" }; + message { "Must be a non-empty single line of no more than 255 chars" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ (length($_[1]) > 0) }; + } + : () + ); + +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 }; -# XXX duplicating constraint msges since moose only uses last message subtype Password, as NonEmptySimpleStr, where { length($_) > 3 }, - message { "Must be between 4 and 255 chars" }; + message { "Must be between 4 and 255 chars" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ (length($_[1]) > 3) }; + } + : () + ); subtype StrongPassword, as Password, where { (length($_) > 7) && (m/[^a-zA-Z]/) }, - message {"Must be between 8 and 255 chars, and contain a non-alpha char" }; + message {"Must be between 8 and 255 chars, and contain a non-alpha char" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ ( (length($_[1]) > 7) && ($_[1] =~ m/[^a-zA-Z]/) ) }; + } + : () + ); subtype NonEmptyStr, as Str, where { length($_) > 0 }, - message { "Must not be empty" }; - + message { "Must not be empty" }, + ( $Moose::VERSION >= 2.0200 + ? inline_as { + $_[0]->parent()->_inline_check( $_[1] ) . ' && ' + . qq{ (length($_[1]) > 0) }; + } + : () + ); + +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; @@ -66,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 @@ -74,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