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, package_len);
name = package;
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 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
