FV::Liteのラッパー

cpanfile

requires 'perl', '5.010001';

# requires 'Some::Module', 'VERSION';
requires 'FormValidator::Lite'    ,'>= 0.37';
requires 'Class::Accessor::Lite', ,'>= 0.05';

on test => sub {
    requires 'Test::More', '0.88';
    requires 'Test::Fatal', '0';
};

MyValidator.pm

package MyValidator;

use strict;
use warnings;

use parent 'Exporter';

use FormValidator::Lite;
use Clone qw/clone/;

=head1 SYNOPSIS
    use 5.10.0;
    use MyValidator qw/Email/;

    sub register {
        my ($class, %args) = @_;

        state $spec = MyValidator->new(
            email => [qw/NOT_NULL EMAIL/],
            pass  => [qw/NOT_NULL ASCII/],
            sex   => {
                rules   => [[IN => qw/male female/],
                default => 'male',
            },
        );

        my $valid = $spec->validate(%args);

        ...
    }
=cut

use Class::Accessor::Lite (
    new => 0,
    rw => [ qw/no_throw/ ],
);

sub import {
    my ($class, @constraints) = @_;
    $class->load_constraints(@constraints);
}

sub new {
    my ( $class, @specs ) = @_;

    my $defaults = {};
    my $rules    = [];

    while ( my ( $name, $spec ) = splice( @specs, 0, 2 ) ) {
        if ( ref($spec) && ref($spec) eq 'HASH' ) {
            $defaults->{$name} = $spec->{default}
              if ( exists $spec->{default} );

            push @$rules, ( $name => $spec->{rules} )
              if ( exists $spec->{rules} );
        }
        else {
            push @$rules, ( $name => $spec );
        }
    }

    return bless {
        rules    => $rules,
        defaults => $defaults
    }, $class;
}

sub rules {
    my $self = shift;
    return (@_) ? { @{ $self->{rules} } }->{ $_[0] } : $self->{rules};
}

sub defaults {
    my $self = shift;
    return (@_) ? $self->{defaults}->{ $_[0] } : $self->{defaults};
}

sub load_constraints {
    my ( $class, @constraints ) = @_;
    FormValidator::Lite->load_constraints(@constraints);
}

sub validate {
    my $self   = shift;
    my $params = {@_};

    my $defaults = $self->defaults();
    for my $key (keys %$defaults) {
        $params->{$key} //= $defaults->{$key};
    }

    my $fv = FormValidator::Lite->new($params);

    $fv->check( @{ $self->rules() } );

    my $valid = {};

    if ( $fv->has_error ) {
        unless ( $self->no_throw ) {
            my @caller = caller;

            MyValidator::ValidateException->throw(
                validator => $fv,
                caller    => \@caller,
            );
        }
    }
    else {
        $valid = +{
            map { ( $_ => $fv->query->param($_) ) } $fv->query->param
        };
    }

    for my $key (keys %$valid) {
        Internals::SvREADONLY($valid->{$key}, 1);
    }

    return (wantarray) ? ( $valid, $fv ) : $valid;
}

package MyValidator::ValidateException;

use parent 'Exception::Tiny';
use Class::Accessor::Lite ro => [qw/validator caller/];

sub as_string {
    my $self = shift;
    my ( $caller, $filename, $line ) = @{ $self->caller };
    my $package = __PACKAGE__;

    return "$package at $caller($filename:$line)";
}

1;

test.t

use strict;
use warnings;
use 5.10.0;

use Test::More;
use Test::Fatal;

use MyValidator qw/Email/;

state $spec = MyValidator->new(
    email      => [qw/NOT_NULL EMAIL/],
    pass       => [qw/NOT_NULL ASCII/],
    pass_again => [qw/NOT_NULL ASCII/],
    { confirm => [qw/pass pass_again/] } => [qw/DUPLICATION/],
    sex => {
        rules   => [ [ IN => qw/male female/ ] ],
        default => 'male',
    },
);

subtest 'with valid params' => sub {
    my $valid = $spec->validate(
        email      => '[email protected]',
        pass       => 'passwd',
        pass_again => 'passwd',
    );

    is_deeply $valid, {
        email      => '[email protected]',
        pass       => 'passwd',
        pass_again => 'passwd',
        sex        => 'male'
    };
};

subtest 'with invalid params' => sub {
    my %args = (
        email => 'invalid email',
        pass  => '',
        sex   => 'sox',
    );

    my $e = exception { $spec->validate(%args) };

    isa_ok $e, 'MyValidator::ValidateException';
    isa_ok $e->validator, 'FormValidator::Lite';
    is_deeply $e->validator->errors, {
        email      => { EMAIL       => 1 },
        pass       => { NOT_NULL    => 1 },
        pass_again => { NOT_NULL    => 1 },
        confirm    => { DUPLICATION => 1 },
        sex        => { IN          => 1 },
    };

    subtest 'when no_throw enabled' => sub {
        $spec->no_throw(1);

        my ( $valid, $validator ) = $spec->validate(%args);

        is_deeply $valid, {};
        ok $validator->has_error;
    };
};

done_testing;

FV::Liteの仕様でNOT_NULL,NOT_BLANK,REQUIREDが "ない" 制約のundef、empty_stringが、チェックをパスする(ActiveRecordの:allow_blankと同じ）ので注意する

ごっつり変更

返り値をInternals::SvREADONLY()してみた