File Coverage

blib/lib/Validation/Class/Directive/Options.pm

Criterion	Covered	Total	%
statement	26	29	89.6
branch	9	14	64.2
condition	4	9	44.4
subroutine	5	5	100.0
pod	0	1	0.0
total	44	58	75.8

# ABSTRACT: Options Directive for Validation Class Field Definitions

package Validation::Class::Directive::Options;

use strict;
use warnings;

use base 'Validation::Class::Directive';

use Validation::Class::Util;

our $VERSION = '7.900059'; # VERSION


has 'mixin'     => 1;
has 'field'     => 1;
has 'multi'     => 0;
has 'message'   => '%s must be either %s';

sub validate {

    my $self = shift;

    my ($proto, $field, $param) = @_;

    if (defined $field->{options} && defined $param) {

        my $options = $field->{options};

        if ( $field->{required} || $param ) {

            my (@options) = isa_arrayref($options) ?
                @{$options} : split /(?:\s{1,})?[,\-]{1,}(?:\s{1,})?/, $options
            ;

            foreach my $option (@options) {
                if ($option =~ /^([^\|]+)\|(.*)/) {
                    $option = $0;
                }
                elsif (isa_arrayref($option)) {
                    $option = $option->[0];
                }
            }

            unless (grep { $param eq $_ } @options) {

                if (my @o = @options) {

                    my$list=(join(' or ',join(', ',@o[0..$#o-1])||(),$o[-1]));

                    $self->error(@_, $list);

                }

            }

        }

    }

    return $self;

}

1;

__END__