view release on metacpan or  search on metacpan

lib/Algorithm/CP/IZ/ParamValidator.pm  view on Meta::CPAN

		}
	    }
	    else {
		if (defined($v) && looks_like_number($v)) {
		    0;
		}
		else {
		    $bad++;
		    1;
		}
	    }
	}
	else {
	    $bad++;
	    1;
	}
    } @$x;

    return $bad == 0;
}

my %Validator = (
    I => \&_is_int,
    V => \&_is_var_or_int,
    C => \&_is_code,
    C0 => \&_is_code_if_defined,
    oV => \&_is_optional_var,
    iA0 => sub { _is_array_of_int(0, @_) },
    iA1 => sub { _is_array_of_int(1, @_) },
    vA0 => sub { _is_array_of_var_or_int(0, @_) },
    vA1 => sub { _is_array_of_var_or_int(1, @_) },
);

sub validate {
    my $params = shift;
    my $types = shift;
    my $hint = shift;

    unless (@$params == @$types) {
	local @CARP_NOT; # to report internal error
	croak __PACKAGE__ . ": n of type does not match with params.";
    }

    for my $i (0..@$params-1) {
	my $rc;

	if (ref $types->[$i] eq 'CODE') {
	    $rc = &{$types->[$i]}($params->[$i]);
	}
	else {
	    unless ($Validator{$types->[$i]}) {
		local @CARP_NOT; # to report internal error
		croak __PACKAGE__ . ": Parameter type($i) " . ($types->[$i] // "undef") . " is not defined.";
	    }

	    $rc = &{$Validator{$types->[$i]}}($params->[$i]);
	}

	unless ($rc) {
	    my ($package, $filename, $line, $subroutine, $hasargs,
		$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller(1);
	    $subroutine =~ /(.*)::([^:]*)$/;
	    my ($p, $s) = ($1, $2);
	    croak "$p: $hint";
	}
    }
}

1;