You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2001/09/16 02:54:33 UTC
cvs commit: modperl-2.0/src/modules/perl modperl_interp.c modperl_interp.h
dougm 01/09/15 17:54:33
Modified: src/modules/perl modperl_interp.c modperl_interp.h
Log:
add routines for walking the interpreter pools
Revision Changes Path
1.35 +64 -0 modperl-2.0/src/modules/perl/modperl_interp.c
Index: modperl_interp.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- modperl_interp.c 2001/08/04 23:27:50 1.34
+++ modperl_interp.c 2001/09/16 00:54:33 1.35
@@ -381,6 +381,70 @@
return interp;
}
+/* currently up to the caller if mip needs locking */
+void modperl_interp_mip_walk(PerlInterpreter *current_perl,
+ PerlInterpreter *parent_perl,
+ modperl_interp_pool_t *mip,
+ modperl_interp_mip_walker_t walker,
+ void *data)
+{
+ modperl_list_t *head = mip->tipool->idle;
+
+ if (!current_perl) {
+ current_perl = PERL_GET_CONTEXT;
+ }
+
+ if (parent_perl) {
+ PERL_SET_CONTEXT(parent_perl);
+ walker(parent_perl, mip, data);
+ }
+
+ while (head) {
+ PerlInterpreter *perl = ((modperl_interp_t *)head->data)->perl;
+ PERL_SET_CONTEXT(perl);
+ walker(perl, mip, data);
+ head = head->next;
+ }
+
+ PERL_SET_CONTEXT(current_perl);
+}
+
+void modperl_interp_mip_walk_servers(PerlInterpreter *current_perl,
+ server_rec *base_server,
+ modperl_interp_mip_walker_t walker,
+ void *data)
+{
+ server_rec *s = base_server->next;
+ modperl_config_srv_t *base_scfg = modperl_config_srv_get(base_server);
+ PerlInterpreter *base_perl = base_scfg->mip->parent->perl;
+
+ modperl_interp_mip_walk(current_perl, base_perl,
+ base_scfg->mip, walker, data);
+
+ while (s) {
+ MP_dSCFG(s);
+ PerlInterpreter *perl = scfg->mip->parent->perl;
+ modperl_interp_pool_t *mip = scfg->mip;
+
+ /* skip vhosts who share parent perl */
+ if (perl == base_perl) {
+ perl = NULL;
+ }
+
+ /* skip vhosts who share parent mip */
+ if (scfg->mip == base_scfg->mip) {
+ mip = NULL;
+ }
+
+ if (perl || mip) {
+ modperl_interp_mip_walk(current_perl, perl,
+ mip, walker, data);
+ }
+
+ s = s->next;
+ }
+}
+
#else
void modperl_interp_init(server_rec *s, apr_pool_t *p,
1.12 +15 -0 modperl-2.0/src/modules/perl/modperl_interp.h
Index: modperl_interp.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- modperl_interp.h 2001/04/09 23:57:22 1.11
+++ modperl_interp.h 2001/09/16 00:54:33 1.12
@@ -42,4 +42,19 @@
#define MP_dINTERP_SELECT(r, c, s) dNOOP
#endif
+typedef apr_status_t (*modperl_interp_mip_walker_t)(pTHX_
+ modperl_interp_pool_t *mip,
+ void *data);
+
+void modperl_interp_mip_walk(PerlInterpreter *current_perl,
+ PerlInterpreter *parent_perl,
+ modperl_interp_pool_t *mip,
+ modperl_interp_mip_walker_t walker,
+ void *data);
+
+void modperl_interp_mip_walk_servers(PerlInterpreter *current_perl,
+ server_rec *base_server,
+ modperl_interp_mip_walker_t walker,
+ void *data);
+
#endif /* MODPERL_INTERP_H */