File Coverage

blib/lib/FormValidator/Simple/Struct/Regex.pm

Criterion	Covered	Total	%
statement	82	88	93.1
branch	33	42	78.5
condition	16	18	88.8
subroutine	18	20	90.0
pod	11	14	78.5
total	160	182	87.9

package FormValidator::Simple::Struct::Regex;
use 5.008_001;
use strict;
use warnings;
use Email::Valid;
use Time::Piece;

our $VERSION = '0.15';

use base 'Exporter';
our @EXPORT= qw/NOT_BLANK INT ASCII STRING DECIMAL EMAIL DATETIME DATE TIME TINYINT URL LENGTH BETWEEN DIGIT_LENGTH/;

sub NOT_BLANK{
    my $s = shift;
    if (defined $s and length($s) > 0 ){
        return 1;
    }

    !!$s;
}

sub INT{
    my $s = shift;
    return 1 unless $s;
    $s =~ m/^\d+$|^-\d+$/;
}

sub ASCII{
    my $s = shift;
    return 1 unless $s;
    $s =~ /^[\x21-\x7E]+$/;
}

sub STRING{
    my $s = shift;
    return 1 unless $s;
    1;
}

sub DECIMAL{
    my $s = shift;
    return 1 unless $s;
    $s =~ m/^\d+\.\d+$|^-\d+\.\d+$/ or INT($s);
}

sub EMAIL{
    my $s = shift;
    return 1 unless $s;
    Email::Valid->address(-address => $s);
}

sub DATETIME{
    my $s = shift;
    return 1 unless $s;
    eval{
        Time::Piece->strptime($s , "%Y-%m-%d %H:%M:%S");
    };
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y/%m/%d %H:%M:%S");
        }
    }
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y-%m-%d %H-%M-%S");
        }
    }
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y/%m/%d %H-%M-%S");
        }
    }
    !$@
}

sub DATE{
    my $s = shift;
    return 1 unless $s;
    eval{
        Time::Piece->strptime($s , "%Y-%m-%d");
    };
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y/%m/%d");
        }
    }
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y-%m-%d");
        }
    }
    if($@){
        eval{
            Time::Piece->strptime($s , "%Y/%m/%d");
        }
    }
    !$@
}

sub TIME{
    my $s = shift;
    return 1 unless $s;
    $s =~ m/\d{2}-\d{2}-\d{2}|\d{2}:\d{2}:\d{2}/;
}

sub TINYINT{
    my $s = shift;
    return 1 unless $s;
    return ($s eq "0" or $s eq "1");
}

sub LENGTH{
    my ($s , $min , $max) = @_;
    my $len = length($s);
    if($len == 0 or $len >= $min and $len <= $max){
        return 1;
    }else{
        return 0;
    }
}

sub DIGIT_LENGTH{
    my ($s , $integer , $decimal) = @_;
    my ($integer_value , $decimal_value) = $s =~ m/(\d+)\.(\d+)/;

    if(length($integer_value) <= $integer && length($decimal_value) <= $decimal){
        return 1;
    }else{
        return 0;
    }
}

sub BETWEEN{
    my ($s , $min , $max) = @_;
    if($s >= $min and $s <= $max){
        return 1;
    }else{
        return 0;
    }
}

sub URL{
    my ($s) = @_;
    return 1 unless $s;
    $s =~ m/^http:\/\/|^https:\/\//;
}

1;
__END__