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/;
: ()
);
-# XXX duplicating constraint msges since moose only uses last message
subtype Password,
as NonEmptySimpleStr,
where { length($_) > 3 },
: ()
);
+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;
=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
=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
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;
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');
--- /dev/null
+#! /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' );