File Coverage

blib/lib/Checkster.pm

Criterion	Covered	Total	%
statement	70	70	100.0
branch	59	68	86.7
condition	20	30	66.6
subroutine	15	15	100.0
pod	0	10	0.0
total	164	193	84.9

package Checkster;
# ABSTRACT: Checkster is a check perl module

use 5.010;
use strict;
use warnings;

our $VERSION = '0.001';

use Exporter 'import';
our @EXPORT_OK = qw(check);


# constructor
sub new {
    my $class = shift;

    return bless {
        _operator => undef,
    }, $class || ref $class;
}


# accessors
sub check {
    return Checkster->new(@_);
}

sub Checkster::not {
    my $self = shift;
    $self->_operator('not');

    $self
}

sub any {
    my $self = shift;
    $self->_operator('any');

    $self
}

sub all {
    my $self = shift;
    $self->_operator('all');

    $self
}

sub op {
    return shift->{_operator};
}

# type check
sub Checkster::array {
    my $self = shift;
    my $value = @_ > 1 ? \@_ : [ shift ];

    # one param test
    if(int(@$value) == 1){
        return ref $value->[0] eq 'ARRAY' ? 1 : 0 unless $self->op;
        return ref $value->[0] eq 'ARRAY' ? 0 : 1 if $self->op && $self->op eq 'not';
    }

    # multi param test
    if(int(@$value) > 1){
        my $res = 0;

        do { $res = 1; map { $res = 0 unless ref $_ eq 'ARRAY' } @$value }
            if !$self->op || $self->op eq 'all';

        map { $res = 1 if ref $_ eq 'ARRAY' } @$value
            if $self->op && $self->op eq 'any';

        return $res;
    }
}

sub number {
    my $self = shift;
    my $value = @_ > 1 ? \@_ : [ shift ];

    # one param test
    if(int(@$value) == 1){
        return $value->[0] =~ /^[\d\.\,]+$/ ? 1 : 0 unless $self->op;
        return $value->[0] =~ /^[\d\.\,]+$/ ? 0 : 1 if $self->op && $self->op eq 'not';
    }

    # multi param test
    if(int(@$value) > 1){
        my $res = 0;

        do { $res = 1; map { $res = 0 unless $_  =~ /^[\d\.\,]+$/ } @$value }
            if !$self->op || $self->op eq 'all';

        map { $res = 1 if ref $_ eq 'ARRAY' } @$value
            if $self->op && $self->op eq 'any';

        return $res;
    }
}

# bool checkers
sub true {
    my $self = shift;
    my $value = @_ > 1 ? \@_ : [ shift ];

    # one param test
    if(int(@$value) == 1){
        return $value->[0] ? 1 : 0 unless $self->op;
        return $value->[0]? 0 : 1 if $self->op && $self->op eq 'not';
    }

    # multi param test
    if(int(@$value) > 1){
        my $res = 0;

        do { $res = 1; map { $res = 0 unless $_ } @$value }
            if !$self->op || $self->op eq 'all';

        map { $res = 1 if $_ } @$value
            if $self->op && $self->op eq 'any';

        return $res;
    }
}

sub false {
    return !shift->true(@_);
}


# private methods
sub _operator {
    my $self = shift;
    $self->{_operator} = $_[0] if $_[0];
}

1;
__END__