cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_callback.c modperl_callback.h modperl_config.c modperl_config.h modperl_filter.c modperl_interp.c modperl_types.h modperl_util.c modperl_util.h
dougm 01/03/09 15:46:38 Modified:lib/ModPerl Code.pm src/modules/perl mod_perl.c mod_perl.h modperl_callback.c modperl_callback.h modperl_config.c modperl_config.h modperl_filter.c modperl_interp.c modperl_types.h modperl_util.c modperl_util.h Log: remove use of Perl structures in modperl_handler_t, as they are not usable in a threaded environment. replace with pre-hashed mgv structures for fast lookup Revision ChangesPath 1.42 +3 -3 modperl-2.0/lib/ModPerl/Code.pm Index: Code.pm === RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v retrieving revision 1.41 retrieving revision 1.42 diff -u -r1.41 -r1.42 --- Code.pm 2001/02/22 03:49:22 1.41 +++ Code.pm 2001/03/09 23:46:33 1.42 @@ -87,10 +87,10 @@ #XXX: allow disabling of PerDir hooks on a PerDir basis my @hook_flags = (map { canon_uc($_) } keys %hooks); my %flags = ( -Srv => [qw(NONE CLONE PARENT ENABLED), @hook_flags, 'UNSET'], +Srv => [qw(NONE CLONE PARENT ENABLED AUTOLOAD), @hook_flags, 'UNSET'], Dir => [qw(NONE SEND_HEADER SETUP_ENV UNSET)], Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)], -Handler => [qw(NONE PARSED METHOD OBJECT ANON)], +Handler => [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD)], ); my %flags_lookup = map { $_,1 } qw(Srv Dir); @@ -453,7 +453,7 @@ ); my @c_src_names = qw(interp tipool log config options callback gtop - util filter); + util filter mgv pcw); my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit); my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names)); sub c_files { [map { "$_.c" } @c_names, @g_c_names] } 1.29 +22 -0 modperl-2.0/src/modules/perl/mod_perl.c Index: mod_perl.c === RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v retrieving revision 1.28 retrieving revision 1.29 diff -u -r1.28 -r1.29 --- mod_perl.c2001/02/04 22:19:11 1.28 +++ mod_perl.c2001/03/09 23:46:34 1.29 @@ -115,6 +115,24 @@ } } +#ifdef USE_ITHREADS +static void modperl_init_clones(server_rec *s, apr_pool_t *p) +{ +for (; s; s=s->next) { +MP_dSCFG(s); +if (scfg->mip->tipool->idle) { +MP_TRACE_i(MP_FUNC, "%s interp already cloned\n", + s->server_hostname); +} +else { +MP_TRACE_i(MP_FUNC, "cloning interp for %s\n", + s->server_hostname); +modperl_tipool_init(scfg->mip->tipool); +} +} +} +#endif + void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s) { @@ -139,6 +157,10 @@ ap_add_version_component(pconf, MP_VERSION_STRING); ap_add_version_component(pconf, Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel)); +modperl_mgv_hash_handlers(pconf, s); +#ifdef USE_ITHREADS +modperl_init_clones(s, pconf); +#endif } void modperl_register_hooks(apr_pool_t *p) 1.26 +2 -0 modperl-2.0/src/modules/perl/mod_perl.h Index: mod_perl.h === RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v retrieving revision 1.25 retrieving revision 1.26 diff -u -r1.25 -r1.26 --- mod_perl.h2001/01/21 23:19:03 1.25 +++ mod_perl.h2001/03/09 23:46:34 1.26 @@ -23,6 +23,8 @@ #include "modperl_options.h" #include "modperl_directives.h" #include "modperl_filter.h" +#include "modperl_pcw.h" +#include "modperl_mgv.h" void modperl_init(server_rec *s, apr_pool_t *p); void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog, 1.21 +55 -251 modperl-2.0/src/modules/perl/modperl_callback.c Index: modperl_callback.c === RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v retrieving revision 1.20 retrieving revision 1.21 diff -u -r1.20 -r1.21 --- modperl_callback.c2001/03/04 18:41:33 1.20 +++ modperl_callback.c2001/03/09 23:46:35 1.21 @@ -1,41 +1,23 @@ #include "mod_perl.h" -static void require_module(pTHX_ const char *pv) +modperl_handler_t *modperl_handler_new(apr_pool_t *p, const char *name) { -SV* sv; -dSP; -PUSHSTACKi(PERLSI_REQUIRE); -PUTBACK; -sv = sv_newmortal(); -sv_setpv(sv, "require "); -sv_catpv(sv, pv); -eval_sv(sv, G_DISCARD); -SPAGAIN; -POPSTACK; -} - -modperl_handler_t *modperl_handler_
cvs commit: modperl-2.0/src/modules/perl modperl_pcw.c modperl_pcw.h
dougm 01/03/09 15:42:28 Added: src/modules/perl modperl_pcw.c modperl_pcw.h Log: module for walking the parsed Apache configuration Revision ChangesPath 1.1 modperl-2.0/src/modules/perl/modperl_pcw.c Index: modperl_pcw.c === #include "mod_perl.h" /* * pcw == Parsed Config Walker * generic functions for walking parsed config using callbacks */ void ap_pcw_walk_location_config(apr_pool_t *pconf, server_rec *s, core_server_config *sconf, module *modp, ap_pcw_dir_walker dw, void *data) { int i; ap_conf_vector_t **urls = (ap_conf_vector_t **)sconf->sec_url->elts; for (i = 0; i < sconf->sec_url->nelts; i++) { core_dir_config *conf = ap_get_module_config(urls[i], &core_module); void *dir_cfg = ap_get_module_config(urls[i], modp); if (!dw(pconf, s, dir_cfg, conf->d, data)) { break; } } } void ap_pcw_walk_directory_config(apr_pool_t *pconf, server_rec *s, core_server_config *sconf, module *modp, ap_pcw_dir_walker dw, void *data) { int i; ap_conf_vector_t **dirs = (ap_conf_vector_t **)sconf->sec->elts; for (i = 0; i < sconf->sec->nelts; i++) { core_dir_config *conf = ap_get_module_config(dirs[i], &core_module); void *dir_cfg = ap_get_module_config(dirs[i], modp); if (!dw(pconf, s, dir_cfg, conf->d, data)) { break; } } } void ap_pcw_walk_files_config(apr_pool_t *pconf, server_rec *s, core_dir_config *dconf, module *modp, ap_pcw_dir_walker dw, void *data) { int i; ap_conf_vector_t **dirs = (ap_conf_vector_t **)dconf->sec->elts; for (i = 0; i < dconf->sec->nelts; i++) { core_dir_config *conf = ap_get_module_config(dirs[i], &core_module); void *dir_cfg = ap_get_module_config(dirs[i], modp); if (!dw(pconf, s, dir_cfg, conf->d, data)) { break; } } } void ap_pcw_walk_default_config(apr_pool_t *pconf, server_rec *s, module *modp, ap_pcw_dir_walker dw, void *data) { core_dir_config *conf = ap_get_module_config(s->lookup_defaults, &core_module); void *dir_cfg = ap_get_module_config(s->lookup_defaults, modp); dw(pconf, s, dir_cfg, conf->d, data); } void ap_pcw_walk_server_config(apr_pool_t *pconf, server_rec *s, module *modp, ap_pcw_srv_walker sw, void *data) { void *cfg = ap_get_module_config(s->module_config, modp); if (!cfg) { return; } sw(pconf, s, cfg, data); } void ap_pcw_walk_config(apr_pool_t *pconf, server_rec *s, module *modp, void *data, ap_pcw_dir_walker dw, ap_pcw_srv_walker sw) { for (; s; s = s->next) { core_dir_config *dconf = ap_get_module_config(s->lookup_defaults, &core_module); core_server_config *sconf = ap_get_module_config(s->module_config, &core_module); if (dw) { ap_pcw_walk_location_config(pconf, s, sconf, modp, dw, data); ap_pcw_walk_directory_config(pconf, s, sconf, modp, dw, data); ap_pcw_walk_files_config(pconf, s, dconf, modp, dw, data); ap_pcw_walk_default_config(pconf, s, modp, dw, data); } if (sw) { ap_pcw_walk_server_config(pconf, s, modp, sw, data); } } } 1.1 modperl-2.0/src/modules/perl/modperl_pcw.h Index: modperl_pcw.h === #ifndef MODPERL_PCW_H #define MODPERL_PCW_H typedef int (*ap_pcw_dir_walker) (apr_pool_t *, server_rec *, void *, char *, void *); typedef int (*ap_pcw_srv_walker) (apr_pool_t *, server_rec *, void *, void *); void ap_pcw_walk_location_config(apr_pool_t *pconf, server_rec *s, core_server_config *sconf, module *modp, ap_pcw_dir_walker dw, void *data); void ap_pcw_walk_directory_config(apr_pool_t *pconf, server_rec *s, core_server_config *sconf,
cvs commit: modperl-2.0/src/modules/perl modperl_mgv.c modperl_mgv.h
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 ChangesPath 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, packag