File Coverage

lib/CGI/ValidOp/Check/number.pm

Criterion	Covered	Total	%
statement	28	29	96.5
branch	7	8	87.5
condition			n/a
subroutine	8	9	88.8
pod	3	5	60.0
total	46	51	90.2

package CGI::ValidOp::Check::number;
use strict;
use warnings;

use base qw/ CGI::ValidOp::Check /;

sub default {
    (
        qr/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/,
        '$label must be a number.',
    )
}

sub integer {
    (
        qr/^[+-]?\d+$/,
        '$label must be an integer.',
    )
}

sub decimal {
    (
        qr/^-?(?:\d+(?:\.\d*)?|\.\d+)$/,
        '$label must be a decimal number.',
    )
}

sub positive_int {
    (
        qr/^[+]?\d+$/,
        '$label must be a positive integer.',
    )
}

sub positive_list {
    my $self = shift;
    sub {
        my ( $input ) = @_;
        return $self->pass() unless defined $input;

        $input =~ m/(.*)/g;
        $input = $1;

        my @values = split(/\s*,\s*/, $input );
        my @bad;
        for my $value ( @values ) {
            next if $value =~ m/^[+]?\d+$/;
            push( @bad, $value );
        }
        if ( @bad ) {
            my $error = '$label: "' . join( ', ', @bad );
            $error .= (@bad > 1) ? '" are not positive integers.'
                                 : '" is not a positive integer.';
            return $self->fail( $error );
        }
        return $self->pass( join(', ', @values ));
    }
}

1;

__END__