File Coverage

blib/lib/Mojolicious/Plugin/AdditionalValidationChecks.pm

Criterion	Covered	Total	%
statement	125	125	100.0
branch	52	52	100.0
condition	22	22	100.0
subroutine	22	22	100.0
pod	1	1	100.0
total	222	222	100.0

package Mojolicious::Plugin::AdditionalValidationChecks;

# ABSTRACT: Add additional validation checks

use Mojo::Base 'Mojolicious::Plugin';

our $VERSION = '0.18';

use Email::Valid;
use Scalar::Util qw(looks_like_number);
use Time::Piece;
use Mojo::URL;

sub register {
    my ($self, $app) = @_;

    my $email = Email::Valid->new(
        allow_ip => 1,
    );

    my $validator = $app->validator;
    $validator->add_check( email => sub {
        my ($self, $field, $value, @params) = @_;
        my $address = $email->address( @params, -address => $value );
        return $address ? 0 : 1;
    });

    $validator->add_check( int => sub {
        my ($nr) = $_[2] =~ m{\A ([\+-]? [0-9]+) \z}x;
        my $return = defined $nr ? 0 : 1;
        return $return;
    });

    $validator->add_check( min => sub {
        return 1 if !looks_like_number( $_[2] );
        return if !length $_[3];
        return $_[2] < $_[3];
    });

    $validator->add_check( max => sub {
        return 1 if !looks_like_number( $_[2] );
        return if !length $_[3];
        return $_[2] > $_[3];
    });

    $validator->add_check( phone => sub {
        return 0 if $_[2] =~ m{\A
            ((?: \+ | 00 ) [1-9]{1}[0-9]{0,2})? # country
            \s*? [0-9]{2,5} \s*?      # local
            [/-]?
            \s*? [0-9]{2,12}          # phone
        \z}x;
        return 1;
    });

    $validator->add_check( length => sub {
        my ($self, $field, $value, $min, $max) = @_;

        my $length = length $value;

        return 0 if !$min && !$max;

        return 1 if $min && $length < $min;
        return 1 if $max && $length > $max;

        return 0;
    });

    $validator->add_check( http_url => sub {
        my $url = Mojo::URL->new( $_[2] );
        return 1 if !$url->is_abs;
        return 1 if !grep{ $url->scheme eq $_ }qw(http https);
        return 0;
    });

    $validator->add_check( not => sub {
        my ($validation, @tmp) = (shift, shift, shift);
        return 0 if !@_;

        my $field = $validation->topic;
        $validation->in( @_ );

        if ( $validation->has_error($field) ) {
            delete $validation->{error}->{$field};
            return 0;
        }

        return 1;
    });

    $validator->add_check( color => sub {
        my ($validation, $field, $value, $type) = @_;

        state $rgb_int = qr{
            \s* (?: 25[0-5] | 2[0-4][0-9] | 1[0-9][0-9] | [1-9][0-9] | [0-9] )
        }x;

        state $rgb_percent = qr{
            \s* (?: 100 | [1-9][0-9] | [0-9] ) \%
        }x;

        state $alpha = qr{
            \s* (?: 0 | 0?\.[0-9]+ | 1(?:\.0)? )
        }x;

        state $types = {
            rgb  => qr{
                \A
                    rgb\(
                        (?:
                            (?:
                                (?:$rgb_int,){2} $rgb_int
                            ) |
                            (?:
                                (?:$rgb_percent,){2} $rgb_percent
                            )
                        )
                    \)
                \z
            }x,
            rgba  => qr{
                \A
                    rgba\(
                        (?:
                            (?:
                                (?:$rgb_int,){3} $alpha
                            ) |
                            (?:
                                (?:$rgb_percent,){3} $alpha
                            )
                        )
                    \)
                \z
            }xms,
            hex  => qr{
                \A
                    \#
                    (?: (?:[0-9A-Fa-f]){3} ){1,2}
                \z
            }xms,
            hsl  => qr{
                \A
                    hsla?\(
                        (?:
                            -? [0-9]+ \s* (?:deg|g?rad|turn)?
                            (?[, ]) \s*
                            $rgb_percent \g{sep} \s*
                            $rgb_percent \s*
                            (?:
                                (?(?{$+{sep} eq ','}) , | / ) \s*
                                (?:$alpha|$rgb_percent)
                            )?
                        )
                    \)
                \z
            }xms,

        };

        return 1 if !$types->{$type};

        my $found = $value =~ $types->{$type};
        return !$found;
    });

    $validator->add_check( uuid => sub {
        my ($validation, $field, $value, $type) = @_;

        my %regexes = (
            3   => qr/\A[0-9A-F]{8}-[0-9A-F]{4}-3[0-9A-F]{3}-[0-9A-F]{4}-[0-9A-F]{12}\z/i,
            4   => qr/\A[0-9A-F]{8}-[0-9A-F]{4}-4[0-9A-F]{3}-[89AB][0-9A-F]{3}-[0-9A-F]{12}\z/i,
            5   => qr/\A[0-9A-F]{8}-[0-9A-F]{4}-5[0-9A-F]{3}-[89AB][0-9A-F]{3}-[0-9A-F]{12}\z/i,
            all => qr/\A[0-9A-F]{8}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{12}\z/i,
        );

        $type ||= 'all';
        my $regex = $regexes{$type};
        $regex    = $regexes{all} if !$regex;

        return $value !~ $regex;
    });

    $validator->add_check( hex => sub {
        my ($validation, $field, $value, $type) = @_;

        return $value !~ m{\A [0-9A-Fa-f]+ \z}xms;
    });

    $validator->add_check( float => sub {
        my ($validation, $field, $value) = @_;

        return $value !~ m{
            \A
                (?:
                    [+-]?
                    (?:[0-9]+)
                )?
                (?:
                    \.
                    [0-9]*
                )
                (?:
                    [eE]
                    [\+\-]?
                    (?:[0-9]+)
                )?
            \z
        }xms;
    });

    $validator->add_check( ip => sub {
        my ($validation, $field, $value, $type) = @_;

        $type //= 4;

        state $octett = qr{
            (?: 25[0-5] | 2[0-4][0-9] | 1[0-9][0-9] | [1-9][0-9] | [0-9] )
        }xms;

        my $ipv4 = "((25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))";
        my $g    = "[0-9a-fA-F]{1,4}";

        my @tail = (
            ":",
            "(:($g)?|$ipv4)",
            ":($ipv4|$g(:$g)?|)",
            "(:$ipv4|:$g(:$ipv4|(:$g){0,2})|:)",
            "((:$g){0,2}(:$ipv4|(:$g){1,2})|:)",
            "((:$g){0,3}(:$ipv4|(:$g){1,2})|:)",
            "((:$g){0,4}(:$ipv4|(:$g){1,2})|:)",
        );

        my $ipv6 = $g;
        $ipv6 = "$g:($ipv6|$_)" for @tail;
        $ipv6 = qq/:(:$g){0,5}((:$g){1,2}|:$ipv4)|$ipv6/;
        $ipv6 =~ s/\(/(?:/g;

        my %regexes = (
            4 => qr/\A (?: $octett \. ){3} $octett \z/xms,
            6 => qr/\A$ipv6\z/,
        );

        my $regex = $regexes{$type};
        $regex    = $regexes{4} if !$regex;

        return $value !~ $regex;
    });

    $validator->add_check( between => sub {
        my $op = (looks_like_number( $_[3] ) and looks_like_number( $_[4] ) ) ? 'n' : 's';

        my $result;
        if ( $op eq 'n' ) {
            $result = $_[2] < $_[3] || $_[2] > $_[4];
        }
        else {
            $result = (
                ( ( $_[2] cmp $_[3] ) == -1 ) ||
                ( ( $_[4] cmp $_[2] ) == -1 )
            );
        }

        return $result;
    });

    $validator->add_check( number => sub {
        my ($validation, @tmp) = (shift, shift, shift);

        return 1 if !looks_like_number( $tmp[1] );

        my $field = $validation->topic;
        $validation->check( 'int', $tmp[1] );

        return 0 if !$validation->has_error($field);

        $validation->output->{$field} = $tmp[1];
        delete $validation->{error}->{$field};

        $validation->check( 'float', $tmp[1] );

        return 0 if !$validation->has_error($field);

        delete $validation->{error}->{$field};

        return 1;
    });

    $validator->add_check( date => sub {
        return 1 if !$_[2];
        return 1 if $_[2] !~ m{\A[0-9]{4}-[0-9]{2}-[0-9]{2}\z};

        my $date;
        eval {
            $date = Time::Piece->strptime( $_[2], '%Y-%m-%d' );
            1;
        } or return 1;

        # this is needed as 2013-02-31 is parsed, but will return 2013-03-03 for ymd()
        return 1 if $_[2] ne $date->ymd;

        return 0;
    });
}

1;

__END__