118 lines
2.2 KiB
Perl
118 lines
2.2 KiB
Perl
use FindBin;
|
|
use Test::More;
|
|
use Data::Dumper;
|
|
|
|
use utf8;
|
|
use strict;
|
|
use warnings;
|
|
|
|
{
|
|
|
|
package TestClass::A;
|
|
|
|
use Validation::Class;
|
|
|
|
field word => {
|
|
all_caps => 1
|
|
};
|
|
|
|
directive all_caps => sub {
|
|
|
|
my ($self, $field, $param) = @_;
|
|
|
|
if (defined $field->{all_caps} && defined $param) {
|
|
|
|
my $length = $field->{all_caps};
|
|
|
|
if ($field->{required} || $param) {
|
|
|
|
unless ($param =~ /^[A-Z]+$/) {
|
|
|
|
$field->errors->add("This is all wrong");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return $self;
|
|
|
|
};
|
|
|
|
package main;
|
|
|
|
my $class = "TestClass::A";
|
|
my $self = $class->new(word => 'blah blah');
|
|
|
|
ok $class eq ref $self, "$class instantiated";
|
|
ok $self->proto->directives->has('all_caps'), "$class has foreign all_caps directives";
|
|
ok !$self->validate('word'), 'word is not in all caps';
|
|
ok $self->error_count, 'an error was registered';
|
|
|
|
}
|
|
|
|
# NO SUPPORT FOR FOREIGN DIRECTIVES ATM, COMING SOON
|
|
#{
|
|
#
|
|
# package AllCaps;
|
|
#
|
|
# use base 'Validation::Class::Directive';
|
|
#
|
|
# use Validation::Class::Directives;
|
|
# use Validation::Class::Util;
|
|
#
|
|
# has 'mixin' => 1;
|
|
# has 'field' => 1;
|
|
# has 'multi' => 0;
|
|
# has 'message' => '%s should be exactly %s characters';
|
|
#
|
|
# sub validate {
|
|
#
|
|
# my $self = shift;
|
|
#
|
|
# my ($proto, $field, $param) = @_;
|
|
#
|
|
# if (defined $field->{all_caps} && defined $param) {
|
|
#
|
|
# my $length = $field->{all_caps};
|
|
#
|
|
# if ($field->{required} || $param) {
|
|
#
|
|
# unless ($param =~ /^[A-Z]+$/) {
|
|
#
|
|
# $self->error(@_, $length);
|
|
#
|
|
# }
|
|
#
|
|
# }
|
|
#
|
|
# }
|
|
#
|
|
# return $self;
|
|
#
|
|
# }
|
|
#
|
|
# package TestClass::B;
|
|
#
|
|
# use Validation::Class;
|
|
#
|
|
# field word => {
|
|
# all_caps => 1
|
|
# };
|
|
#
|
|
# package main;
|
|
#
|
|
# my $class = "TestClass::B";
|
|
# my $self = $class->new(word => 'blah blah');
|
|
#
|
|
# ok $class eq ref $self, "$class instantiated";
|
|
# ok $self->proto->directives->has('all_caps'), "$class has foreign all_caps directives";
|
|
# ok !$self->validate('word'), 'word is not in all caps';
|
|
#
|
|
# warn $self->errors_to_string;
|
|
#
|
|
#}
|
|
|
|
done_testing;
|