File Coverage

blib/lib/Kossy/Validator.pm

Criterion	Covered	Total	%
statement	95	104	91.3
branch	38	44	86.3
condition	12	17	70.5
subroutine	11	12	91.6
pod	0	1	0.0
total	156	178	87.6

package Kossy::Validator;

use 5.008005;
use strict;
use warnings;
use Hash::MultiValue;

our $VERSION = "0.01";

our %VALIDATOR = (
    NOT_NULL => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        return if $val eq "";
        return 1;
    },
    CHOICE => sub {
        my ($req, $val, @args) = @_;
        for my $c (@args) {
            if ($c eq $val) {
                return 1;
            }
        }
        return;
    },
    INT => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\-?[\d]+$/;
    },
    UINT => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\d+$/;
    },
    NATURAL => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\d+$/ && $val > 0;
    },
    FLOAT => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\-?(\d+\.?\d*|\.\d+)(e[+-]\d+)?$/;
    },
    DOUBLE => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\-?(\d+\.?\d*|\.\d+)(e[+-]\d+)?$/;
    },
    REAL => sub {
        my ($req,$val) = @_;
        return if not defined($val);
        $val =~ /^\-?(\d+\.?\d*|\.\d+)(e[+-]\d+)?$/;
    },
    '@SELECTED_NUM' => sub {
        my ($req,$vals,@args) = @_;
        my ($min,$max) = @args;
        scalar(@$vals) >= $min && scalar(@$vals) <= $max
    },
    '@SELECTED_UNIQ' => sub {
        my ($req,$vals) = @_;
        my %vals;
        $vals{$_} = 1 for @$vals;
        scalar(@$vals) == scalar keys %vals;
    },
);

sub check {
    my $class = shift;

    my $req = shift;
    my $rule = shift || [];

    my @errors;
    my $valid = Hash::MultiValue->new;

    for ( my $i=0; $i < @$rule; $i = $i+2 ) {
        my $param = $rule->[$i];
        my $constraints;
        my $param_name = $param;
        $param_name =~ s!^@!!;
        my @vals = $req->param($param_name);
        my $vals = ( $param =~ m!^@! ) ? \@vals : [$vals[-1]];

        if ( ref($rule->[$i+1]) && ref($rule->[$i+1]) eq 'HASH' ) {
            if ( $param !~ m!^@! && !$VALIDATOR{NOT_NULL}->($req,$vals->[0])  && exists $rule->[$i+1]->{default} ) {
                my $default = $rule->[$i+1]->{default};
                $default = $default->() if ref($default) && ref($default) eq 'CODE';
                $vals = [$default];
            }
            $constraints = $rule->[$i+1]->{rule};
        }
        else {
            $constraints = $rule->[$i+1];
        }

        my $error;
        PARAM_CONSTRAINT: for my $constraint ( @$constraints ) {
            if ( ref($constraint->[0]) eq 'ARRAY' ) {
                my @constraint = @{$constraint->[0]};
                my $constraint_name = shift @constraint;
                if ( ref($constraint_name) && ref($constraint_name) eq 'CODE' ) {
                    for my $val ( @$vals ) {
                        if ( !$constraint_name->($req, $val, @constraint) ) {
                            push @errors, { param => $param_name, message => $constraint->[1] };
                            $error=1;
                            last PARAM_CONSTRAINT;
                        }
                    }
                    next PARAM_CONSTRAINT;
                }
                die "constraint:$constraint_name not found" if ! exists $VALIDATOR{$constraint_name};
                if ( $constraint_name =~ m!^@! ) {
                    if ( !$VALIDATOR{$constraint_name}->($req,$vals,@constraint) ) {
                        push @errors, { param => $param_name, message => $constraint->[1] };
                        $error=1;
                        last PARAM_CONSTRAINT;
                    }
                }
                else {
                    for my $val ( @$vals ) {
                        if ( !$VALIDATOR{$constraint_name}->($req,$val,@constraint) ) {
                            push @errors, { param => $param_name, message => $constraint->[1] };
                            $error=1;
                            last PARAM_CONSTRAINT;
                        }
                    }
                }
            }
            elsif ( ref($constraint->[0]) eq 'CODE' ) {
                for my $val ( @$vals ) {
                    if ( !$constraint->[0]->($req, $val) ) {
                        push @errors, { param => $param_name, message => $constraint->[1] };
                        $error=1;
                        last PARAM_CONSTRAINT;
                    }
                }
            }
            else {
                die "constraint:".$constraint->[0]." not found" if ! exists $VALIDATOR{$constraint->[0]};
                if ( $constraint->[0] =~ m!^@! ) {
                    if ( !$VALIDATOR{$constraint->[0]}->($req,$vals) ) {
                        push @errors, { param => $param_name, message => $constraint->[1] };
                        $error=1;
                        last PARAM_CONSTRAINT;
                    }
                }
                else {
                    for my $val ( @$vals ) {
                        if ( !$VALIDATOR{$constraint->[0]}->($req, $val) ) {
                            push @errors, { param => $param_name, message => $constraint->[1] };
                            $error=1;
                            last PARAM_CONSTRAINT;
                        }
                    }
                }
            }
        }
        $valid->add($param_name,@$vals) unless $error;
    }

    Kossy::Validator::Result->new(\@errors,$valid);
}

package Kossy::Validator::Result;

use strict;
use warnings;

sub new {
    my $class = shift;
    my $errors = shift;
    my $valid = shift;
    bless {errors=>$errors,valid=>$valid}, $class;
}

sub has_error {
    my $self = shift;
    return 1 if @{$self->{errors}};
    return;
}

sub messages {
    my $self = shift;
    my @errors = map { $_->{message} } @{$self->{errors}};
    \@errors;
}

sub errors {
    my $self = shift;
    my %errors = map { $_->{param} => $_->{message} } @{$self->{errors}};
    \%errors;
}

sub valid {
    my $self = shift;
    if ( @_ == 2 ) {
        $self->{valid}->add(@_);
        return $_[1];
    }
    elsif ( @_ == 1 ) {
        return $self->{valid}->get($_[0]) if ! wantarray;
        return $self->{valid}->get_all($_[0]);
    }
    $self->{valid};
}


1;
__END__