/* Copyright (c) 2000-2012 Dave Rolsky and Ilya Martynov */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define NEED_PL_parser
#define NEED_caller_cx
#define NEED_eval_pv
#define NEED_load_module
#define NEED_sv_2pv_flags
#define NEED_vload_module
#include "ppport.h"
#if (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
#define INLINE inline
#else
#define INLINE
#endif
/* type constants */
#define SCALAR 1
#define ARRAYREF 2
#define HASHREF 4
#define CODEREF 8
#define GLOB 16
#define GLOBREF 32
#define SCALARREF 64
#define UNKNOWN 128
#define UNDEF 256
#define OBJECT 512
#define HANDLE (GLOB | GLOBREF)
#define BOOLEAN (SCALAR | UNDEF)
/* return data macros */
#define RETURN_ARRAY(ret) \
STMT_START \
{ \
I32 i; \
switch(GIMME_V) \
{ \
case G_VOID: \
return; \
case G_ARRAY: \
EXTEND(SP, av_len(ret) + 1); \
for(i = 0; i <= av_len(ret); i++) \
{ \
PUSHs(*av_fetch(ret, i, 1)); \
} \
break; \
case G_SCALAR: \
XPUSHs(sv_2mortal(newRV_inc((SV*) ret))); \
break; \
} \
} STMT_END \
#define RETURN_HASH(ret) \
STMT_START \
{ \
HE* he; \
I32 keys; \
switch(GIMME_V) \
{ \
case G_VOID: \
return; \
case G_ARRAY: \
keys = hv_iterinit(ret); \
EXTEND(SP, keys * 2); \
while ((he = hv_iternext(ret))) \
{ \
PUSHs(HeSVKEY_force(he)); \
PUSHs(HeVAL(he)); \
} \
break; \
case G_SCALAR: \
XPUSHs(sv_2mortal(newRV_inc((SV*) ret))); \
break; \
} \
} STMT_END
static SV *module;
void peek(SV *thing)
{
if (NULL == module) {
module = newSVpv("Devel::Peek", 0);
load_module(PERL_LOADMOD_NOIMPORT, module, NULL);
}
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(thing);
PUTBACK;
(void)call_pv("Devel::Peek::Dump", G_VOID);
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
}
}
INLINE static bool
no_validation() {
SV* no_v;
no_v = get_sv("Params::Validate::NO_VALIDATION", 0);
if (! no_v)
croak("Cannot retrieve $Params::Validate::NO_VALIDATION\n");
return SvTRUE(no_v);
}
/* return type string that corresponds to typemask */
INLINE static SV*
typemask_to_string(IV mask) {
SV* buffer;
IV empty = 1;
buffer = sv_2mortal(newSVpv("", 0));
if (mask & SCALAR) {
sv_catpv(buffer, "scalar");
empty = 0;
}
if (mask & ARRAYREF) {
sv_catpv(buffer, empty ? "arrayref" : " arrayref");
empty = 0;
}
if (mask & HASHREF) {
sv_catpv(buffer, empty ? "hashref" : " hashref");
empty = 0;
}
if (mask & CODEREF) {
sv_catpv(buffer, empty ? "coderef" : " coderef");
empty = 0;
}
if (mask & GLOB) {
sv_catpv(buffer, empty ? "glob" : " glob");
empty = 0;
}
if (mask & GLOBREF) {
sv_catpv(buffer, empty ? "globref" : " globref");
empty = 0;
}
if (mask & SCALARREF) {
sv_catpv(buffer, empty ? "scalarref" : " scalarref");
empty = 0;
}
if (mask & UNDEF) {
sv_catpv(buffer, empty ? "undef" : " undef");
empty = 0;
}
if (mask & OBJECT) {
sv_catpv(buffer, empty ? "object" : " object");
empty = 0;
}
if (mask & UNKNOWN) {
sv_catpv(buffer, empty ? "unknown" : " unknown");
empty = 0;
}
return buffer;
}
/* compute numberic datatype for variable */
INLINE static IV
get_type(SV* sv) {
IV type = 0;
if (SvTYPE(sv) == SVt_PVGV) {
return GLOB;
}
if (!SvOK(sv)) {
return UNDEF;
}
if (!SvROK(sv)) {
return SCALAR;
}
switch (SvTYPE(SvRV(sv))) {
case SVt_NULL:
case SVt_IV:
case SVt_NV:
case SVt_PV:
#if PERL_VERSION <= 10
case SVt_RV:
#endif
case SVt_PVMG:
case SVt_PVIV:
case SVt_PVNV:
#if PERL_VERSION <= 8
case SVt_PVBM:
#elif PERL_VERSION >= 11
case SVt_REGEXP:
#endif
type = SCALARREF;
break;
case SVt_PVAV:
type = ARRAYREF;
break;
case SVt_PVHV:
type = HASHREF;
break;
case SVt_PVCV:
type = CODEREF;
break;
case SVt_PVGV:
type = GLOBREF;
break;
/* Perl 5.10 has a bunch of new types that I don't think will ever
actually show up here (I hope), but not handling them makes the
C compiler cranky. */
default:
type = UNKNOWN;
break;
}
if (type) {
if (sv_isobject(sv)) return type | OBJECT;
return type;
}
/* Getting here should not be possible */
return UNKNOWN;
}
/* get an article for given string */
INLINE static const char*
article(SV* string) {
STRLEN len;
char* rawstr;
rawstr = SvPV(string, len);
if (len) {
switch(rawstr[0]) {
case 'a':
case 'e':
case 'i':
case 'o':
case 'u':
return "an";
}
}
return "a";
}
char *
string_representation(SV* value) {
if(SvOK(value)) {
return (void *)form("\"%s\"", SvPV_nolen(value));
}
else {
return (void *)"undef";
}
}
/* raises exception either using user-defined callback or using
built-in method */
static void
validation_failure(SV* message, HV* options) {
SV** temp;
SV* on_fail;
if ((temp = hv_fetch(options, "on_fail", 7, 0))) {
SvGETMAGIC(*temp);
on_fail = *temp;
}
else {
on_fail = NULL;
}
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
mXPUSHs(message);
PUTBACK;
/* use user defined callback if available */
if (on_fail) {
call_sv(on_fail, G_DISCARD);
}
else {
/* by default resort to Carp::confess for error reporting */
call_pv("Carp::confess", G_DISCARD);
}
/* We shouldn't get here if the thing we just called dies, but it
doesn't hurt to be careful. */
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
}
return;
}
/* get called subroutine fully qualified name */
static SV*
get_caller(HV* options) {
SV** temp;
if ((temp = hv_fetch(options, "called", 6, 0))) {
SvGETMAGIC(*temp);
SvREFCNT_inc(*temp);
return *temp;
}
else {
IV frame;
SV *caller;
#if PERL_VERSION >= 14
const PERL_CONTEXT *cx;
GV *cvgv;
# else
SV *buffer;
#endif
if ((temp = hv_fetch(options, "stack_skip", 10, 0))) {
SvGETMAGIC(*temp);
frame = SvIV(*temp);
}
else {
frame = 1;
}
#if PERL_VERSION >= 14
if (frame > 0) {
frame--;
}
cx = caller_cx(frame, NULL);
if (cx) {
switch (CxTYPE(cx)) {
case CXt_EVAL:
caller = newSVpv("\"eval\"", 6);
break;
case CXt_SUB:
cvgv = CvGV(cx->blk_sub.cv);
caller = newSV(0);
if (cvgv && isGV(cvgv)) {
gv_efullname4(caller, cvgv, NULL, 1);
}
break;
default:
caller = newSVpv("(unknown)", 9);
break;
}
}
else {
caller = newSVpv("(unknown)", 9);
}
#else
buffer = sv_2mortal(newSVpvf("(caller(%d))[3]", (int) frame));
caller = eval_pv(SvPV_nolen(buffer), 1);
if (SvTYPE(caller) == SVt_NULL) {
sv_setpv(caller, "(unknown");
}
/* This will be decremented by the code that asked for this value, but
we need to do this here because the return value of caller() is
mortal and has a refcnt of 1. */
SvREFCNT_inc(caller);
#endif
return caller;
}
}
/* $value->isa alike validation */
static IV
validate_isa(SV* value, SV* package, char* id, HV* options) {
IV ok = 1;
if (! value) {
return 0;
}
SvGETMAGIC(value);
if (SvOK(value) && (sv_isobject(value) || (SvPOK(value) && ! looks_like_number(value)))) {
dSP;
SV* ret;
IV count;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(value);
PUSHs(package);
PUTBACK;
count = call_method("isa", G_SCALAR);
if (! count)
croak("Calling isa did not return a value");
SPAGAIN;
ret = POPs;
SvGETMAGIC(ret);
ok = SvTRUE(ret);
PUTBACK;
FREETMPS;
LEAVE;
}
else {
ok = 0;
}
if (! ok) {
SV *caller = get_caller(options);
SV* buffer = newSVpvf(id, string_representation(value));
sv_catpv(buffer, " to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " was not ");
sv_catpv(buffer, article(package));
sv_catpv(buffer, " '");
sv_catsv(buffer, package);
sv_catpv(buffer, "' (it is ");
if ( SvOK(value) ) {
sv_catpv(buffer, article(value));
sv_catpv(buffer, " ");
sv_catsv(buffer, value);
}
else {
sv_catpv(buffer, "undef");
}
sv_catpv(buffer, ")\n");
validation_failure(buffer, options);
}
return 1;
}
static IV
validate_can(SV* value, SV* method, char* id, HV* options) {
IV ok = 1;
if (! value) {
return 0;
}
SvGETMAGIC(value);
if (SvOK(value) && (sv_isobject(value) || (SvPOK(value) && ! looks_like_number(value)))) {
dSP;
SV* ret;
IV count;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(value);
PUSHs(method);
PUTBACK;
count = call_method("can", G_SCALAR);
if (! count)
croak("Calling can did not return a value");
SPAGAIN;
ret = POPs;
SvGETMAGIC(ret);
ok = SvTRUE(ret);
PUTBACK;
FREETMPS;
LEAVE;
}
else {
ok = 0;
}
if (! ok) {
SV* buffer = newSVpvf(id, string_representation(value));
SV *caller = get_caller(options);
sv_catpv(buffer, " to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " does not have the method: '");
sv_catsv(buffer, method);
sv_catpv(buffer, "'\n");
validation_failure(buffer, options);
}
return 1;
}
/* validates specific parameter using supplied parameter specification */
static IV
validate_one_param(SV* value, SV* params, HV* spec, char* id, HV* options, IV* untaint) {
SV** temp;
IV i;
/*
HE* he;
hv_iterinit(spec);
while (he = hv_iternext(spec)) {
STRLEN len;
char* key = HePV(he, len);
int ok = 0;
int j;
for ( j = 0; j < VALID_KEY_COUNT; j++ ) {
if ( strcmp( key, valid_keys[j] ) == 0) {
ok = 1;
break;
}
}
if ( ! ok ) {
SV* buffer = sv_2mortal(newSVpv("\"",0));
sv_catpv( buffer, key );
sv_catpv( buffer, "\" is not an allowed validation spec key\n");
validation_failure(buffer, options);
}
}
*/
/* check type */
if ((temp = hv_fetch(spec, "type", 4, 0))) {
IV type;
if ( ! ( SvOK(*temp)
&& looks_like_number(*temp)
&& SvIV(*temp) > 0 ) ) {
SV* buffer = newSVpvf(id, string_representation(value));
sv_catpv( buffer, " has a type specification which is not a number. It is ");
if ( SvOK(*temp) ) {
sv_catpv( buffer, "a string - " );
sv_catsv( buffer, *temp );
}
else {
sv_catpv( buffer, "undef");
}
sv_catpv( buffer, ".\n Use the constants exported by Params::Validate to declare types." );
validation_failure(buffer, options);
}
SvGETMAGIC(*temp);
type = get_type(value);
if (! (type & SvIV(*temp))) {
SV* buffer = newSVpvf(id, string_representation(value));
SV *caller = get_caller(options);
SV* is;
SV* allowed;
sv_catpv(buffer, " to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " was ");
is = typemask_to_string(type);
allowed = typemask_to_string(SvIV(*temp));
sv_catpv(buffer, article(is));
sv_catpv(buffer, " '");
sv_catsv(buffer, is);
sv_catpv(buffer, "', which is not one of the allowed types: ");
sv_catsv(buffer, allowed);
sv_catpv(buffer, "\n");
validation_failure(buffer, options);
}
}
/* check isa */
if ((temp = hv_fetch(spec, "isa", 3, 0))) {
SvGETMAGIC(*temp);
if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVAV) {
AV* array = (AV*) SvRV(*temp);
for(i = 0; i <= av_len(array); i++) {
SV* package;
package = *av_fetch(array, i, 1);
if (! package) {
return 0;
}
SvGETMAGIC(package);
if (! validate_isa(value, package, id, options)) {
return 0;
}
}
}
else {
if (! validate_isa(value, *temp, id, options)) {
return 0;
}
}
}
/* check can */
if ((temp = hv_fetch(spec, "can", 3, 0))) {
SvGETMAGIC(*temp);
if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVAV) {
AV* array = (AV*) SvRV(*temp);
for (i = 0; i <= av_len(array); i++) {
SV* method;
method = *av_fetch(array, i, 1);
if (! method) {
return 0;
}
SvGETMAGIC(method);
if (! validate_can(value, method, id, options)) {
return 0;
}
}
}
else {
if (! validate_can(value, *temp, id, options)) {
return 0;
}
}
}
/* let callbacks to do their tests */
if ((temp = hv_fetch(spec, "callbacks", 9, 0))) {
HE* he;
SvGETMAGIC(*temp);
if (!(SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVHV)) {
SV* buffer = newSVpv("'callbacks' validation parameter for '", 0);
SV *caller = get_caller(options);
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " must be a hash reference\n");
validation_failure(buffer, options);
}
hv_iterinit((HV*) SvRV(*temp));
while ((he = hv_iternext((HV*) SvRV(*temp)))) {
SV* ret;
IV ok;
IV count;
SV *err;
if (!(SvROK(HeVAL(he)) && SvTYPE(SvRV(HeVAL(he))) == SVt_PVCV)) {
SV* buffer = newSVpv("callback '", 0);
SV *caller = get_caller(options);
sv_catsv(buffer, HeSVKEY_force(he));
sv_catpv(buffer, "' for ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " is not a subroutine reference\n");
validation_failure(buffer, options);
}
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(value);
mPUSHs(newRV_inc(params));
PUTBACK;
/* local $@ = q{}; */
save_scalar(PL_errgv);
sv_setpv(ERRSV, "");
count = call_sv(SvRV(HeVAL(he)), G_EVAL|G_SCALAR);
SPAGAIN;
if (!count) {
croak("Validation callback did not return anything");
}
ret = POPs;
SvGETMAGIC(ret);
ok = SvTRUE(ret);
err = newSV(0);
SvSetSV_nosteal(err, ERRSV);
PUTBACK;
FREETMPS;
LEAVE;
if (! ok) {
if (SvROK(err)) {
validation_failure(err, options);
}
else {
SV* buffer = newSVpvf(id, string_representation(value));
SV *caller = get_caller(options);
sv_catpv(buffer, " to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " did not pass the '");
sv_catsv(buffer, HeSVKEY_force(he));
sv_catpv(buffer, "' callback");
if (SvCUR(err) > 0) {
sv_catpv(buffer, ": ");
sv_catsv(buffer, err);
}
sv_catpv(buffer, "\n");
validation_failure(buffer, options);
}
}
else {
SvREFCNT_dec(err);
}
}
}
}
if ((temp = hv_fetch(spec, "regex", 5, 0))) {
dSP;
IV has_regex = 0;
IV ok;
SvGETMAGIC(*temp);
if (SvPOK(*temp)) {
has_regex = 1;
}
else if (SvROK(*temp)) {
SV* svp;
svp = (SV*)SvRV(*temp);
#if PERL_VERSION <= 10
if (SvMAGICAL(svp) && mg_find(svp, PERL_MAGIC_qr)) {
has_regex = 1;
}
#else
if (SvTYPE(svp) == SVt_REGEXP) {
has_regex = 1;
}
#endif
}
if (!has_regex) {
SV* buffer = newSVpv("'regex' validation parameter for '", 0);
SV *caller = get_caller(options);
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " must be a string or qr// regex\n");
validation_failure(buffer, options);
}
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(value);
PUSHs(*temp);
PUTBACK;
call_pv("Params::Validate::XS::_check_regex_from_xs", G_SCALAR);
SPAGAIN;
ok = POPi;
PUTBACK;
if (! ok) {
SV* buffer = newSVpvf(id, string_representation(value));
SV *caller = get_caller(options);
sv_catpv(buffer, " to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " did not pass regex check\n");
validation_failure(buffer, options);
}
}
if ((temp = hv_fetch(spec, "untaint", 7, 0))) {
if (SvTRUE(*temp)) {
*untaint = 1;
}
}
return 1;
}
/* merges one hash into another (not deep copy) */
static void
merge_hashes(HV* in, HV* out) {
HE* he;
hv_iterinit(in);
while ((he = hv_iternext(in))) {
if (!hv_store_ent(out, HeSVKEY_force(he),
SvREFCNT_inc(HeVAL(he)), HeHASH(he))) {
SvREFCNT_dec(HeVAL(he));
croak("Cannot add new key to hash");
}
}
}
/* convert array to hash */
static IV
convert_array2hash(AV* in, HV* options, HV* out) {
IV i;
I32 len;
len = av_len(in);
if (len > -1 && len % 2 != 1) {
SV* buffer = newSVpv("Odd number of parameters in call to ", 0);
SV *caller = get_caller(options);
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " when named parameters were expected\n");
validation_failure(buffer, options);
}
for (i = 0; i <= av_len(in); i += 2) {
SV* key;
SV* value;
key = *av_fetch(in, i, 1);
if (! key) {
continue;
}
SvGETMAGIC(key);
/* We need to make a copy because if the array was @_, then the
values in the array are marked as readonly, which causes
problems when the hash being made gets returned to the
caller. */
value = sv_2mortal( newSVsv( *av_fetch(in, i + 1, 1) ) );
if (value) {
SvGETMAGIC(value);
}
if (! hv_store_ent(out, key, SvREFCNT_inc(value), 0)) {
SvREFCNT_dec(value);
croak("Cannot add new key to hash");
}
}
return 1;
}
/* get current Params::Validate options */
static HV*
get_options(HV* options) {
HV* OPTIONS;
HV* ret;
HE *he;
HV *stash;
SV* pkg;
SV *pkg_options;
ret = (HV*) sv_2mortal((SV*) newHV());
/* get package specific options */
stash = CopSTASH(PL_curcop);
pkg = sv_2mortal(newSVpv(HvNAME(stash), 0));
OPTIONS = get_hv("Params::Validate::OPTIONS", 1);
if ((he = hv_fetch_ent(OPTIONS, pkg, 0, 0))) {
pkg_options = HeVAL(he);
SvGETMAGIC(pkg_options);
if (SvROK(pkg_options) && SvTYPE(SvRV(pkg_options)) == SVt_PVHV) {
if (options) {
merge_hashes((HV*) SvRV(pkg_options), ret);
}
else {
return (HV*) SvRV(pkg_options);
}
}
}
if (options) {
merge_hashes(options, ret);
}
return ret;
}
static SV*
normalize_one_key(SV* key, SV* normalize_func, SV* strip_leading, IV ignore_case) {
SV* copy;
STRLEN len_sl;
STRLEN len;
char *rawstr_sl;
char *rawstr;
copy = sv_2mortal(newSVsv(key));
/* if normalize_func is provided, ignore the other options */
if (normalize_func) {
dSP;
SV* normalized;
PUSHMARK(SP);
XPUSHs(copy);
PUTBACK;
if (! call_sv(SvRV(normalize_func), G_SCALAR)) {
croak("The normalize_keys callback did not return anything");
}
SPAGAIN;
normalized = POPs;
PUTBACK;
if (! SvOK(normalized)) {
croak("The normalize_keys callback did not return a defined value when normalizing the key '%s'", SvPV_nolen(copy));
}
return normalized;
}
else if (ignore_case || strip_leading) {
if (ignore_case) {
STRLEN i;
rawstr = SvPV(copy, len);
for (i = 0; i < len; i++) {
/* should this account for UTF8 strings? */
*(rawstr + i) = toLOWER(*(rawstr + i));
}
}
if (strip_leading) {
rawstr_sl = SvPV(strip_leading, len_sl);
rawstr = SvPV(copy, len);
if (len > len_sl && strnEQ(rawstr_sl, rawstr, len_sl)) {
copy = sv_2mortal(newSVpvn(rawstr + len_sl, len - len_sl));
}
}
}
return copy;
}
static HV*
normalize_hash_keys(HV* p, SV* normalize_func, SV* strip_leading, IV ignore_case) {
SV* normalized;
HE* he;
HV* norm_p;
if (!normalize_func && !ignore_case && !strip_leading) {
return p;
}
norm_p = (HV*) sv_2mortal((SV*) newHV());
hv_iterinit(p);
while ((he = hv_iternext(p))) {
normalized =
normalize_one_key(HeSVKEY_force(he), normalize_func, strip_leading, ignore_case);
if (hv_fetch_ent(norm_p, normalized, 0, 0)) {
croak("The normalize_keys callback returned a key that already exists, '%s', when normalizing the key '%s'",
SvPV_nolen(normalized), SvPV_nolen(HeSVKEY_force(he)));
}
if (! hv_store_ent(norm_p, normalized, SvREFCNT_inc(HeVAL(he)), 0)) {
SvREFCNT_dec(HeVAL(he));
croak("Cannot add new key to hash");
}
}
return norm_p;
}
static IV
validate_pos_depends(AV* p, AV* specs, HV* options) {
IV p_idx;
SV** depends;
SV** p_spec;
for (p_idx = 0; p_idx <= av_len(p); p_idx++) {
p_spec = av_fetch(specs, p_idx, 0);
if (p_spec != NULL && SvROK(*p_spec) &&
SvTYPE(SvRV(*p_spec)) == SVt_PVHV) {
depends = hv_fetch((HV*) SvRV(*p_spec), "depends", 7, 0);
if (! depends) {
return 1;
}
if (SvROK(*depends)) {
croak("Arguments to 'depends' for validate_pos() must be a scalar");
}
if (av_len(p) < SvIV(*depends) -1) {
SV *buffer =
newSVpvf("Parameter #%d depends on parameter #%d, which was not given",
(int) p_idx + 1,
(int) SvIV(*depends));
validation_failure(buffer, options);
}
}
}
return 1;
}
static IV
validate_named_depends(HV* p, HV* specs, HV* options) {
HE* he;
HE* he1;
SV* buffer;
SV** depends_value;
AV* depends_list;
SV* depend_name;
SV* temp;
I32 d_idx;
/* the basic idea here is to iterate through the parameters
* (which we assumed to have already gone through validation
* via validate_one_param()), and the check to see if that
* parameter contains a "depends" spec. If it does, we'll
* check if that parameter specified by depends exists in p
*/
hv_iterinit(p);
while ((he = hv_iternext(p))) {
he1 = hv_fetch_ent(specs, HeSVKEY_force(he), 0, HeHASH(he));
if (he1 && SvROK(HeVAL(he1)) &&
SvTYPE(SvRV(HeVAL(he1))) == SVt_PVHV) {
if (hv_exists((HV*) SvRV(HeVAL(he1)), "depends", 7)) {
depends_value = hv_fetch((HV*) SvRV(HeVAL(he1)), "depends", 7, 0);
if (! depends_value) {
return 1;
}
if (! SvROK(*depends_value)) {
depends_list = (AV*) sv_2mortal((SV*) newAV());
temp = sv_2mortal(newSVsv(*depends_value));
av_push(depends_list,SvREFCNT_inc(temp));
}
else if (SvTYPE(SvRV(*depends_value)) == SVt_PVAV) {
depends_list = (AV*) SvRV(*depends_value);
}
else {
croak("Arguments to 'depends' must be a scalar or arrayref");
}
for (d_idx =0; d_idx <= av_len(depends_list); d_idx++) {
depend_name = *av_fetch(depends_list, d_idx, 0);
/* first check if the parameter to which this
* depends on was given to us
*/
if (!hv_exists(p, SvPV_nolen(depend_name),
SvCUR(depend_name))) {
/* oh-oh, the parameter that this parameter
* depends on is not available. Let's first check
* if this is even valid in the spec (i.e., the
* spec actually contains a spec for such parameter)
*/
if (!hv_exists(specs, SvPV_nolen(depend_name),
SvCUR(depend_name))) {
buffer =
sv_2mortal(newSVpv("Following parameter specified in depends for '", 0));
sv_catsv(buffer, HeSVKEY_force(he1));
sv_catpv(buffer, "' does not exist in spec: ");
sv_catsv(buffer, depend_name);
croak("%s", SvPV_nolen(buffer));
}
/* if we got here, the spec was correct. we just
* need to issue a regular validation failure
*/
buffer = newSVpv( "Parameter '", 0);
sv_catsv(buffer, HeSVKEY_force(he1));
sv_catpv(buffer, "' depends on parameter '");
sv_catsv(buffer, depend_name);
sv_catpv(buffer, "', which was not given");
validation_failure(buffer, options);
}
}
}
}
}
return 1;
}
void
apply_defaults(HV *ret, HV *p, HV *specs, AV *missing) {
HE* he;
SV** temp;
hv_iterinit(specs);
while ((he = hv_iternext(specs))) {
HV* spec;
SV* val;
val = HeVAL(he);
/* get extended param spec if available */
if (val && SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
spec = (HV*) SvRV(val);
}
else {
spec = NULL;
}
/* test for parameter existence */
if (hv_exists_ent(p, HeSVKEY_force(he), HeHASH(he))) {
continue;
}
/* parameter may not be defined but we may have default */
if (spec && (temp = hv_fetch(spec, "default", 7, 0))) {
SV* value;
SvGETMAGIC(*temp);
value = sv_2mortal(newSVsv(*temp));
/* make sure that parameter is put into return hash */
if (GIMME_V != G_VOID) {
if (!hv_store_ent(ret, HeSVKEY_force(he),
SvREFCNT_inc(value), HeHASH(he))) {
SvREFCNT_dec(value);
croak("Cannot add new key to hash");
}
}
continue;
}
/* find if missing parameter is mandatory */
if (! no_validation()) {
SV** temp;
if (spec) {
if ((temp = hv_fetch(spec, "optional", 8, 0))) {
SvGETMAGIC(*temp);
if (SvTRUE(*temp)) continue;
}
}
else if (!SvTRUE(HeVAL(he))) {
continue;
}
av_push(missing, SvREFCNT_inc(HeSVKEY_force(he)));
}
}
}
static IV
validate(HV* p, HV* specs, HV* options, HV* ret) {
AV* missing;
AV* unmentioned;
HE* he;
HE* he1;
SV* hv;
SV* hv1;
IV ignore_case = 0;
SV* strip_leading = NULL;
IV allow_extra = 0;
SV** temp;
SV* normalize_func = NULL;
AV* untaint_keys = (AV*) sv_2mortal((SV*) newAV());
IV i;
if ((temp = hv_fetch(options, "ignore_case", 11, 0))) {
SvGETMAGIC(*temp);
ignore_case = SvTRUE(*temp);
}
if ((temp = hv_fetch(options, "strip_leading", 13, 0))) {
SvGETMAGIC(*temp);
if (SvOK(*temp)) strip_leading = *temp;
}
if ((temp = hv_fetch(options, "normalize_keys", 14, 0))) {
SvGETMAGIC(*temp);
if(SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVCV) {
normalize_func = *temp;
}
}
if (normalize_func || ignore_case || strip_leading) {
p = normalize_hash_keys(p, normalize_func, strip_leading, ignore_case);
specs = normalize_hash_keys(specs, normalize_func, strip_leading, ignore_case);
}
/* short-circuit everything else when no_validation is true */
if (no_validation()) {
if (GIMME_V != G_VOID) {
while ((he = hv_iternext(p))) {
hv = HeVAL(he);
if (! hv) {
continue;
}
SvGETMAGIC(hv);
/* put the parameter into return hash */
if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(hv),
HeHASH(he))) {
SvREFCNT_dec(hv);
croak("Cannot add new key to hash");
}
}
apply_defaults(ret, p, specs, NULL);
}
return 1;
}
if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
SvGETMAGIC(*temp);
allow_extra = SvTRUE(*temp);
}
/* find extra parameters and validate good parameters */
unmentioned = (AV*) sv_2mortal((SV*) newAV());
hv_iterinit(p);
while ((he = hv_iternext(p))) {
hv = HeVAL(he);
if (! hv) {
continue;
}
SvGETMAGIC(hv);
/* put the parameter into return hash */
if (GIMME_V != G_VOID) {
if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(hv),
HeHASH(he))) {
SvREFCNT_dec(hv);
croak("Cannot add new key to hash");
}
}
/* check if this parameter is defined in spec and if it is
then validate it using spec */
he1 = hv_fetch_ent(specs, HeSVKEY_force(he), 0, HeHASH(he));
if(he1) {
hv1 = HeVAL(he1);
if (SvROK(hv1) && SvTYPE(SvRV(hv1)) == SVt_PVHV) {
char* buffer;
HV* spec;
IV untaint = 0;
spec = (HV*) SvRV(hv1);
buffer = form("The '%s' parameter (%%s)", HePV(he, PL_na));
if (! validate_one_param(hv, (SV*) p, spec, buffer, options, &untaint))
return 0;
/* The value stored here is meaningless, we're just tracking
keys to untaint later */
if (untaint) {
av_push(untaint_keys, SvREFCNT_inc(HeSVKEY_force(he1)));
}
}
}
else if (! allow_extra) {
av_push(unmentioned, SvREFCNT_inc(HeSVKEY_force(he)));
}
if (av_len(unmentioned) > -1) {
SV* buffer = newSVpv("The following parameter", 0);
SV *caller = get_caller(options);
if (av_len(unmentioned) != 0) {
sv_catpv(buffer, "s were ");
}
else {
sv_catpv(buffer, " was ");
}
sv_catpv(buffer, "passed in the call to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, " but ");
if (av_len(unmentioned) != 0) {
sv_catpv(buffer, "were ");
}
else {
sv_catpv(buffer, "was ");
}
sv_catpv(buffer, "not listed in the validation options: ");
for(i = 0; i <= av_len(unmentioned); i++) {
sv_catsv(buffer, *av_fetch(unmentioned, i, 1));
if (i < av_len(unmentioned)) {
sv_catpv(buffer, " ");
}
}
sv_catpv(buffer, "\n");
validation_failure(buffer, options);
}
}
validate_named_depends(p, specs, options);
/* find missing parameters */
missing = (AV*) sv_2mortal((SV*) newAV());
apply_defaults(ret, p, specs, missing);
if (av_len(missing) > -1) {
sortsv(AvARRAY(missing), 1 + av_len(missing), Perl_sv_cmp);
SV* buffer = newSVpv("Mandatory parameter", 0);
SV *caller = get_caller(options);
if (av_len(missing) > 0) {
sv_catpv(buffer, "s ");
}
else {
sv_catpv(buffer, " ");
}
for(i = 0; i <= av_len(missing); i++) {
sv_catpvf(buffer, "'%s'",
SvPV_nolen(*av_fetch(missing, i, 0)));
if (i < av_len(missing)) {
sv_catpv(buffer, ", ");
}
}
sv_catpv(buffer, " missing in call to ");
sv_catsv(buffer, caller);
SvREFCNT_dec(caller);
sv_catpv(buffer, "\n");
validation_failure(buffer, options);
}
if (GIMME_V != G_VOID) {
for (i = 0; i <= av_len(untaint_keys); i++) {
SvTAINTED_off(HeVAL(hv_fetch_ent(p, *av_fetch(untaint_keys, i, 0), 0, 0)));
}
}
return 1;
}
static SV*
validate_pos_failure(IV pnum, IV min, IV max, HV* options) {
SV* buffer;
SV** temp;
IV allow_extra;
if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
SvGETMAGIC(*temp);
allow_extra = SvTRUE(*temp);
}
else {
allow_extra = 0;
}
buffer = newSViv(pnum + 1);
if (pnum != 0) {
sv_catpv(buffer, " parameters were passed to ");
}
else {
sv_catpv(buffer, " parameter was passed to ");
}
sv_catsv(buffer, get_caller(options));
sv_catpv(buffer, " but ");
if (!allow_extra) {
if (min != max) {
sv_catpvf(buffer, "%d - %d", (int) min + 1, (int) max + 1);
}
else {
sv_catpvf(buffer, "%d", (int) max + 1);
}
}
else {
sv_catpvf(buffer, "at least %d", (int) min + 1);
}
if ((allow_extra ? min : max) != 0) {
sv_catpv(buffer, " were expected\n");
}
else {
sv_catpv(buffer, " was expected\n");
}
return buffer;
}
/* Given a single parameter spec and a corresponding complex spec form
of it (which must be false if the spec is not complex), return true
says that the parameter is options. */
static bool
spec_says_optional(SV* spec, IV complex_spec) {
SV** temp;
if (complex_spec) {
if ((temp = hv_fetch((HV*) SvRV(spec), "optional", 8, 0))) {
SvGETMAGIC(*temp);
if (!SvTRUE(*temp))
return FALSE;
}
else {
return FALSE;
}
}
else {
if (SvTRUE(spec)) {
return FALSE;
}
}
return TRUE;
}
static IV
validate_pos(AV* p, AV* specs, HV* options, AV* ret) {
char* buffer;
SV* value;
SV* spec = NULL;
SV** temp;
IV i;
IV complex_spec = 0;
IV allow_extra;
/* Index of highest-indexed required parameter known so far, or -1
if no required parameters are known yet. */
IV min = -1;
AV* untaint_indexes = (AV*) sv_2mortal((SV*) newAV());
if (no_validation()) {
IV spec_count = av_len(specs);
IV p_count = av_len(p);
IV max = spec_count > p_count ? spec_count : p_count;
if (GIMME_V == G_VOID) {
return 1;
}
for (i = 0; i <= max; i++) {
if (i <= spec_count) {
spec = *av_fetch(specs, i, 1);
if (spec) {
SvGETMAGIC(spec);
}
complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
}
if (i <= av_len(p)) {
value = *av_fetch(p, i, 1);
SvGETMAGIC(value);
av_push(ret, SvREFCNT_inc(value));
} else if (complex_spec &&
(temp = hv_fetch((HV*) SvRV(spec), "default", 7, 0))) {
SvGETMAGIC(*temp);
av_push(ret, SvREFCNT_inc(*temp));
}
}
return 1;
}
/* iterate through all parameters and validate them */
for (i = 0; i <= av_len(specs); i++) {
spec = *av_fetch(specs, i, 1);
if (! spec) {
continue;
}
SvGETMAGIC(spec);
complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
/* Unless the current spec refers to an optional argument, update
our notion of the index of the highest-idexed required
parameter. */
if (! spec_says_optional(spec, complex_spec) ) {
min = i;
}
if (i <= av_len(p)) {
value = *av_fetch(p, i, 1);
SvGETMAGIC(value);
if (complex_spec) {
IV untaint = 0;
buffer = form("Parameter #%d (%%s)", (int)i + 1);
if (! validate_one_param(value, (SV*) p, (HV*) SvRV(spec), buffer, options, &untaint)) {
return 0;
}
if (untaint) {
av_push(untaint_indexes, newSViv(i));
}
}
if (GIMME_V != G_VOID) {
av_push(ret, SvREFCNT_inc(value));
}
} else if (complex_spec &&
(temp = hv_fetch((HV*) SvRV(spec), "default", 7, 0))) {
SvGETMAGIC(*temp);
if (GIMME_V != G_VOID) {
av_store(ret, i, SvREFCNT_inc(*temp));
}
}
else {
if (i == min) {
/* We don't have as many arguments as the arg spec requires. */
SV* buffer;
/* Look forward through remaining argument specifications to
find the last non-optional one, so we can correctly report the
number of arguments required. */
for (i++ ; i <= av_len(specs); i++) {
spec = *av_fetch(specs, i, 1);
if (! spec) {
continue;
}
SvGETMAGIC(spec);
complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
if (! spec_says_optional(spec, complex_spec)) {
min = i;
}
if (min != i)
break;
}
buffer = validate_pos_failure(av_len(p), min, av_len(specs), options);
validation_failure(buffer, options);
}
}
}
validate_pos_depends(p, specs, options);
/* test for extra parameters */
if (av_len(p) > av_len(specs)) {
if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
SvGETMAGIC(*temp);
allow_extra = SvTRUE(*temp);
}
else {
allow_extra = 0;
}
if (allow_extra) {
/* put all additional parameters into return array */
if (GIMME_V != G_VOID) {
for(i = av_len(specs) + 1; i <= av_len(p); i++) {
value = *av_fetch(p, i, 1);
if (value) {
SvGETMAGIC(value);
av_push(ret, SvREFCNT_inc(value));
}
else {
av_push(ret, &PL_sv_undef);
}
}
}
}
else {
SV* buffer = validate_pos_failure(av_len(p), min, av_len(specs), options);
validation_failure(buffer, options);
}
}
if (GIMME_V != G_VOID) {
for (i = 0; i <= av_len(untaint_indexes); i++) {
SvTAINTED_off(*av_fetch(p, SvIV(*av_fetch(untaint_indexes, i, 0)), 0));
}
}
return 1;
}
MODULE = Params::Validate::XS PACKAGE = Params::Validate::XS
void
validate(p, specs)
SV* p
SV* specs
PROTOTYPE: \@$
PPCODE:
HV* ret = NULL;
AV* pa;
HV* ph;
HV* options;
IV ok;
if (no_validation() && GIMME_V == G_VOID) {
XSRETURN(0);
}
SvGETMAGIC(p);
if (! (SvROK(p) && SvTYPE(SvRV(p)) == SVt_PVAV)) {
croak("Expecting array reference as first parameter");
}
SvGETMAGIC(specs);
if (! (SvROK(specs) && SvTYPE(SvRV(specs)) == SVt_PVHV)) {
croak("Expecting hash reference as second parameter");
}
pa = (AV*) SvRV(p);
ph = NULL;
if (av_len(pa) == 0) {
/* we were called as validate( @_, ... ) where @_ has a
single element, a hash reference */
SV* value;
value = *av_fetch(pa, 0, 1);
if (value) {
SvGETMAGIC(value);
if (SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVHV) {
ph = (HV*) SvRV(value);
}
}
}
options = get_options(NULL);
if (! ph) {
ph = (HV*) sv_2mortal((SV*) newHV());
PUTBACK;
ok = convert_array2hash(pa, options, ph);
SPAGAIN;
if (!ok) {
XSRETURN(0);
}
}
if (GIMME_V != G_VOID) {
ret = (HV*) sv_2mortal((SV*) newHV());
}
PUTBACK;
ok = validate(ph, (HV*) SvRV(specs), options, ret);
SPAGAIN;
if (! ok) {
XSRETURN(0);
}
RETURN_HASH(ret);
void
validate_pos(p, ...)
SV* p
PROTOTYPE: \@@
PPCODE:
AV* specs;
AV* ret = NULL;
IV i;
IV ok;
if (no_validation() && GIMME_V == G_VOID) {
XSRETURN(0);
}
SvGETMAGIC(p);
if (!SvROK(p) || !(SvTYPE(SvRV(p)) == SVt_PVAV)) {
croak("Expecting array reference as first parameter");
}
specs = (AV*) sv_2mortal((SV*) newAV());
av_extend(specs, items);
for(i = 1; i < items; i++) {
if (!av_store(specs, i - 1, SvREFCNT_inc(ST(i)))) {
SvREFCNT_dec(ST(i));
croak("Cannot store value in array");
}
}
if (GIMME_V != G_VOID) {
ret = (AV*) sv_2mortal((SV*) newAV());
}
PUTBACK;
ok = validate_pos((AV*) SvRV(p), specs, get_options(NULL), ret);
SPAGAIN;
if (! ok) {
XSRETURN(0);
}
RETURN_ARRAY(ret);
void
validate_with(...)
PPCODE:
HV* p;
SV* params;
SV* spec;
IV i;
IV ok;
if (no_validation() && GIMME_V == G_VOID) XSRETURN(0);
/* put input list into hash */
p = (HV*) sv_2mortal((SV*) newHV());
for(i = 0; i < items; i += 2) {
SV* key;
SV* value;
key = ST(i);
if (i + 1 < items) {
value = ST(i + 1);
}
else {
value = &PL_sv_undef;
}
if (! hv_store_ent(p, key, SvREFCNT_inc(value), 0)) {
SvREFCNT_dec(value);
croak("Cannot add new key to hash");
}
}
params = *hv_fetch(p, "params", 6, 1);
SvGETMAGIC(params);
spec = *hv_fetch(p, "spec", 4, 1);
SvGETMAGIC(spec);
if (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVAV) {
if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVAV) {
AV* ret = NULL;
if (GIMME_V != G_VOID) {
ret = (AV*) sv_2mortal((SV*) newAV());
}
PUTBACK;
ok = validate_pos((AV*) SvRV(params), (AV*) SvRV(spec), get_options(p), ret);
SPAGAIN;
if (! ok) {
XSRETURN(0);
}
RETURN_ARRAY(ret);
}
else {
croak("Expecting array reference in 'params'");
}
}
else if (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV) {
HV* hv;
HV* ret = NULL;
HV* options;
options = get_options(p);
if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVHV) {
hv = (HV*) SvRV(params);
}
else if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVAV) {
I32 hv_set = 0;
/* Check to see if we have a one element array
containing a hash reference */
if (av_len((AV*) SvRV(params)) == 0) {
SV** first_elem;
first_elem = av_fetch((AV*) SvRV(params), 0, 0);
if (first_elem && SvROK(*first_elem) &&
SvTYPE(SvRV(*first_elem)) == SVt_PVHV) {
hv = (HV*) SvRV(*first_elem);
hv_set = 1;
}
}
if (! hv_set) {
hv = (HV*) sv_2mortal((SV*) newHV());
PUTBACK;
ok = convert_array2hash((AV*) SvRV(params), options, hv);
SPAGAIN;
if (!ok) {
XSRETURN(0);
}
}
}
else {
croak("Expecting array or hash reference in 'params'");
}
if (GIMME_V != G_VOID) {
ret = (HV*) sv_2mortal((SV*) newHV());
}
PUTBACK;
ok = validate(hv, (HV*) SvRV(spec), options, ret);
SPAGAIN;
if (! ok) {
XSRETURN(0);
}
RETURN_HASH(ret);
}
else {
croak("Expecting array or hash reference in 'spec'");
}