The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;