dougm 01/04/11 15:48:29 Added: src/modules/perl modperl_const.c modperl_const.h Log: module for compiling/exporting constants Revision Changes Path 1.1 modperl-2.0/src/modules/perl/modperl_const.c Index: modperl_const.c =================================================================== #include "mod_perl.h" #include "modperl_const.h" typedef int (*constants_lookup)(const char *); typedef const char ** (*constants_group_lookup)(const char *); static int new_constsub(pTHX_ constants_lookup lookup, HV *caller_stash, HV *stash, const char *name) { int name_len = strlen(name); GV **gvp = (GV **)hv_fetch(stash, name, name_len, FALSE); int val; /* dont redefine */ if (!(gvp && GvCV(*gvp))) { CV *cv; val = (*lookup)(name); #if 0 fprintf(stderr, "newCONSTSUB(%s, %s, %d)\n", HvNAME(stash), name, val); #endif cv = newCONSTSUB(stash, (char *)name, newSViv(val)); gvp = &CvGV(cv); } /* export into callers namespace */ if (gvp && caller_stash) { GV *alias = *(GV **)hv_fetch(caller_stash, (char *)name, name_len, TRUE); if (!isGV(alias)) { gv_init(alias, caller_stash, name, name_len, TRUE); } GvCV(alias) = GvCV(*gvp); } return val; } int modperl_const_compile(pTHX_ const char *classname, const char *arg, const char *name) { HV *stash = gv_stashpv(classname, TRUE); HV *caller_stash = Nullhv; constants_lookup lookup; constants_group_lookup group_lookup; if (strnEQ(classname, "APR", 3)) { lookup = modperl_constants_lookup_apr; group_lookup = modperl_constants_group_lookup_apr; } else { lookup = modperl_constants_lookup_apache; group_lookup = modperl_constants_group_lookup_apache; } if (*arg != '-') { /* only export into callers namespace without -compile arg */ caller_stash = gv_stashpv(arg, TRUE); } if (*name == ':') { int i; const char **group; name++; group = (*group_lookup)(name); for (i=0; group[i]; i++) { new_constsub(aTHX_ lookup, caller_stash, stash, group[i]); } } else { new_constsub(aTHX_ lookup, caller_stash, stash, name); } return 1; } XS(XS_modperl_const_compile) { I32 i; STRLEN n_a; char *stashname = HvNAME(GvSTASH(CvGV(cv))); const char *classname, *arg; dXSARGS; if (items < 2) { Perl_croak(aTHX_ "Usage: %s->compile(...)"); } classname = *(stashname + 1) == 'P' ? "APR" : "Apache"; arg = SvPV(ST(1),n_a); for (i=2; i<items; i++) { (void)modperl_const_compile(aTHX_ classname, arg, SvPV(ST(i), n_a)); } XSRETURN_YES; } 1.1 modperl-2.0/src/modules/perl/modperl_const.h Index: modperl_const.h =================================================================== #ifndef MODPERL_CONST_H #define MODPERL_CONST_H #include "modperl_constants.h" int modperl_const_compile(pTHX_ const char *classname, const char *arg, const char *name); XS(XS_modperl_const_compile); #endif /* MODPERL_CONST_H */