dougm 01/03/09 15:42:05 Added: src/modules/perl modperl_mgv.c modperl_mgv.h Log: module for pre-computing gv_fetchpv lookups of handlers Revision Changes Path 1.1 modperl-2.0/src/modules/perl/modperl_mgv.c Index: modperl_mgv.c =================================================================== #include "mod_perl.h" /* * mgv = ModPerl Glob Value || Mostly Glob Value * as close to GV as we can get without actually using a GV * need config structures to be free of Perl structures */ #define modperl_mgv_new_w_name(mgv, p, n, copy) \ mgv = modperl_mgv_new(p); \ mgv->len = strlen(n); \ mgv->name = (copy ? apr_pstrndup(p, n, mgv->len) : n) #define modperl_mgv_new_name(mgv, p, n) \ modperl_mgv_new_w_name(mgv, p, n, 1) #define modperl_mgv_new_namen(mgv, p, n) \ modperl_mgv_new_w_name(mgv, p, n, 0) /* * similar to hv_fetch_ent, but takes string key and key len rather than SV * also skips magic and utf8 fu, since we are only dealing with symbol tables */ static HE *S_hv_fetch_he(pTHX_ HV *hv, register char *key, register I32 klen, register U32 hash) { register XPVHV *xhv; register HE *entry; xhv = (XPVHV *)SvANY(hv); entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) continue; if (HeKLEN(entry) != klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) continue; return entry; } return 0; } #define hv_fetch_he(hv,k,l,h) S_hv_fetch_he(aTHX_ hv,k,l,h) modperl_mgv_t *modperl_mgv_new(apr_pool_t *p) { return (modperl_mgv_t *)apr_pcalloc(p, sizeof(modperl_mgv_t)); } #define modperl_mgv_get_next(mgv) \ if (mgv->name) { \ mgv->next = modperl_mgv_new(p); \ mgv = mgv->next; \ } #define modperl_mgv_hash(mgv) \ PERL_HASH(mgv->hash, mgv->name, mgv->len) /* MP_TRACE_h(MP_FUNC, "%s...hash=%ld\n", mgv->name, mgv->hash) */ modperl_mgv_t *modperl_mgv_compile(pTHX_ apr_pool_t *p, register const char *name) { register const char *namend; I32 len; modperl_mgv_t *symbol = modperl_mgv_new(p); modperl_mgv_t *mgv = symbol; /* @mgv = split '::', $name */ for (namend = name; *namend; namend++) { if (*namend == ':' && namend[1] == ':') { if ((len = (namend - name)) > 0) { modperl_mgv_get_next(mgv); mgv->name = apr_palloc(p, len+3); Copy(name, mgv->name, len, char); mgv->name[len++] = ':'; mgv->name[len++] = ':'; mgv->name[len] = '\0'; mgv->len = len; modperl_mgv_hash(mgv); } name = namend + 2; } } modperl_mgv_get_next(mgv); mgv->len = namend - name; mgv->name = apr_pstrndup(p, name, mgv->len); modperl_mgv_hash(mgv); return symbol; } void modperl_mgv_append(pTHX_ apr_pool_t *p, modperl_mgv_t *symbol, const char *name) { modperl_mgv_t *mgv = symbol; while (mgv->next) { mgv = mgv->next; } mgv->name = apr_pstrcat(p, mgv->name, "::", NULL); mgv->len += 2; modperl_mgv_hash(mgv); mgv->next = modperl_mgv_compile(aTHX_ p, name); } /* faster replacement for gv_fetchpv() */ GV *modperl_mgv_lookup(pTHX_ modperl_mgv_t *symbol) { HV *stash = PL_defstash; modperl_mgv_t *mgv; if (!symbol->hash) { /* special case for MyClass->handler */ return (GV*)sv_2mortal(newSVpvn(symbol->name, symbol->len)); } for (mgv = symbol; mgv; mgv = mgv->next) { HE *he = hv_fetch_he(stash, mgv->name, mgv->len, mgv->hash); if (he) { if (mgv->next) { stash = GvHV((GV *)HeVAL(he)); } else { return (GV *)HeVAL(he); } } else { return Nullgv; } } return Nullgv; } int modperl_mgv_resolve(pTHX_ modperl_handler_t *handler, apr_pool_t *p, const char *name) { CV *cv; GV *gv; HV *stash=Nullhv; char *handler_name = "handler"; char *tmp; if (strnEQ(name, "sub ", 4)) { MP_TRACE_h(MP_FUNC, "handler is anonymous\n"); MpHandlerANON_On(handler); MpHandlerPARSED_On(handler); return 1; } if ((tmp = strstr((char *)name, "->"))) { int package_len = strlen(name) - strlen(tmp); char *package = apr_pstrndup(p, name, package_len); name = package; handler_name = &tmp[2]; MpHandlerMETHOD_On(handler); if (*package == '$') { GV *gv; SV *obj; handler->mgv_obj = modperl_mgv_compile(aTHX_ p, package + 1); gv = modperl_mgv_lookup(aTHX_ handler->mgv_obj); obj = gv ? GvSV(gv) : Nullsv; if (SvTRUE(obj)) { if (SvROK(obj) && sv_isobject(obj)) { stash = SvSTASH(SvRV(obj)); MpHandlerOBJECT_On(handler); MP_TRACE_h(MP_FUNC, "handler object %s isa %s\n", package, HvNAME(stash)); } else { MP_TRACE_h(MP_FUNC, "%s is not an object, pv=%s\n", package, SvPV_nolen(obj)); return 0; } } else { MP_TRACE_h(MP_FUNC, "failed to thaw %s\n", package); return 0; } } if (!stash) { if ((stash = gv_stashpvn(package, package_len, FALSE))) { MP_TRACE_h(MP_FUNC, "handler method %s isa %s\n", name, HvNAME(stash)); } } MpHandlerPARSED_On(handler); } else { if ((cv = get_cv(name, FALSE))) { handler->mgv_cv = modperl_mgv_compile(aTHX, p, HvNAME(GvSTASH(CvGV(cv)))); modperl_mgv_append(aTHX_ p, handler->mgv_cv, GvNAME(CvGV(cv))); MpHandlerPARSED_On(handler); return 1; } } if (!(stash || (stash = gv_stashpv(name, FALSE))) && MpHandlerAUTOLOAD(handler)) { MP_TRACE_h(MP_FUNC, "package %s not defined, attempting to load\n", name); if (modperl_require_module(aTHX_ name)) { MP_TRACE_h(MP_FUNC, "loaded %s package\n", name); if (!(stash = gv_stashpv(name, FALSE))) { MP_TRACE_h(MP_FUNC, "%s package still does not exist\n", name); return 0; } } else { MP_TRACE_h(MP_FUNC, "failed to load %s package\n", name); return 0; } } if ((gv = gv_fetchmethod(stash, handler_name)) && (cv = GvCV(gv))) { if (CvFLAGS(cv) & CVf_METHOD) { /* sub foo : method {}; */ MpHandlerMETHOD_On(handler); if (!handler->mgv_obj) { modperl_mgv_new_name(handler->mgv_obj, p, HvNAME(stash)); } } /* note: this is the real function after @ISA lookup */ handler->mgv_cv = modperl_mgv_compile(aTHX_ p, HvNAME(GvSTASH(gv))); modperl_mgv_append(aTHX_ p, handler->mgv_cv, handler_name); MpHandlerPARSED_On(handler); MP_TRACE_h(MP_FUNC, "found `%s' in class `%s' as a %s\n", handler_name, HvNAME(stash), MpHandlerMETHOD(handler) ? "method" : "function"); return 1; } MP_TRACE_h(MP_FUNC, "`%s' not found in class `%s'\n", handler_name, name); return 0; } char *modperl_mgv_as_string(pTHX_ modperl_mgv_t *symbol, apr_pool_t *p) { char *string, *ptr; modperl_mgv_t *mgv; int len = 0; for (mgv = symbol; mgv; mgv = mgv->next) { len += mgv->len; } ptr = string = apr_palloc(p, len+1); for (mgv = symbol; mgv; mgv = mgv->next) { Copy(mgv->name, ptr, mgv->len, char); ptr += mgv->len; } *ptr = '\0'; return string; } /* precompute the hash(es) for handler names */ static void modperl_hash_handlers(pTHX_ apr_pool_t *p, server_rec *s, MpAV *entry) { MP_dSCFG(s); int i; modperl_handler_t **handlers; if (!entry) { return; } handlers = (modperl_handler_t **)entry->elts; for (i=0; i < entry->nelts; i++) { modperl_handler_t *handler = handlers[i]; if (MpHandlerPARSED(handler)) { MP_TRACE_h(MP_FUNC, "%s already resolved\n", handler->name); } else { if (MpSrvAUTOLOAD(scfg)) { MpHandlerAUTOLOAD_On(handler); } modperl_mgv_resolve(aTHX_ handler, p, handler->name); } } } static int modperl_dw_hash_handlers(apr_pool_t *p, server_rec *s, void *cfg, char *d, void *data) { MP_dSCFG(s); MP_dSCFG_dTHX; int i; modperl_dir_config_t *dir_cfg = (modperl_dir_config_t *)cfg; if (!dir_cfg) { return 1; } for (i=0; i < MP_PER_DIR_NUM_HANDLERS; i++) { modperl_hash_handlers(aTHX_ p, s, dir_cfg->handlers[i]); } return 1; } static int modperl_sw_hash_handlers(apr_pool_t *p, server_rec *s, void *cfg, void *data) { int i; modperl_srv_config_t *scfg = (modperl_srv_config_t *)cfg; MP_dSCFG_dTHX; for (i=0; i < MP_PER_SRV_NUM_HANDLERS; i++) { modperl_hash_handlers(aTHX_ p, s, scfg->handlers[i]); } for (i=0; i < MP_PROCESS_NUM_HANDLERS; i++) { modperl_hash_handlers(aTHX_ p, s, scfg->process_cfg->handlers[i]); } for (i=0; i < MP_CONNECTION_NUM_HANDLERS; i++) { modperl_hash_handlers(aTHX_ p, s, scfg->connection_cfg->handlers[i]); } for (i=0; i < MP_FILES_NUM_HANDLERS; i++) { modperl_hash_handlers(aTHX_ p, s, scfg->files_cfg->handlers[i]); } return 1; } void modperl_mgv_hash_handlers(apr_pool_t *p, server_rec *s) { ap_pcw_walk_config(p, s, &perl_module, NULL, modperl_dw_hash_handlers, modperl_sw_hash_handlers); } 1.1 modperl-2.0/src/modules/perl/modperl_mgv.h Index: modperl_mgv.h =================================================================== #ifndef MODPERL_MGV_H #define MODPERL_MGV_H modperl_mgv_t *modperl_mgv_new(apr_pool_t *p); modperl_mgv_t *modperl_mgv_compile(pTHX_ apr_pool_t *p, const char *name); GV *modperl_mgv_lookup(pTHX_ modperl_mgv_t *symbol); int modperl_mgv_resolve(pTHX_ modperl_handler_t *handler, apr_pool_t *p, const char *name); void modperl_mgv_append(pTHX_ apr_pool_t *p, modperl_mgv_t *symbol, const char *name); char *modperl_mgv_as_string(pTHX_ modperl_mgv_t *symbol, apr_pool_t *p); void modperl_mgv_hash_handlers(apr_pool_t *p, server_rec *s); #define modperl_mgv_sv(sv) \ (isGV(sv) ? GvSV(sv) : (SV*)sv) #define modperl_mgv_cv(sv) \ GvCV(sv) #endif /* MODPERL_MGV_H */