stas 2004/07/09 17:36:19
Modified: lib/ModPerl MapUtil.pm StructureMap.pm TypeMap.pm WrapXS.pm
src/modules/perl mod_perl.c mod_perl.h
Log:
supports a new type of struct accessor, which is just like read/write
one, but doesn't allow write access starting at the ChildInit phase
under threaded mpm (to avoid thread-safely issues)
Revision Changes Path
1.8 +2 -0 modperl-2.0/lib/ModPerl/MapUtil.pm
Index: MapUtil.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/MapUtil.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -u -r1.7 -r1.8
--- MapUtil.pm 23 Jun 2004 03:30:15 -0000 1.7
+++ MapUtil.pm 10 Jul 2004 00:36:19 -0000 1.8
@@ -25,8 +25,10 @@
our @ISA = qw(Exporter);
+# the mapping happens in lib/ModPerl/StructureMap.pm
# '<' => 'auto-generated but gives only a read-only access'
# '&' => 'RDWR accessor to a char* field, supporting undef arg'
+# '$' => 'RONLY accessor, with WRITE accessor before child_init'
my %disabled_map = (
'!' => 'disabled or not yet implemented',
'~' => 'implemented but not auto-generated',
1.7 +3 -0 modperl-2.0/lib/ModPerl/StructureMap.pm
Index: StructureMap.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/StructureMap.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -u -r1.6 -r1.7
--- StructureMap.pm 28 May 2004 01:35:15 -0000 1.6
+++ StructureMap.pm 10 Jul 2004 00:36:19 -0000 1.7
@@ -125,6 +125,9 @@
elsif ($1 eq '&') {
$map->{$class}->{$_} = 'rw_char_undef';
}
+ elsif ($1 eq '$') {
+ $map->{$class}->{$_} = 'r+w_startup';
+ }
}
else {
$map->{$class}->{$_} = undef;
1.22 +1 -1 modperl-2.0/lib/ModPerl/TypeMap.pm
Index: TypeMap.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TypeMap.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -u -r1.21 -r1.22
--- TypeMap.pm 17 May 2004 22:57:21 -0000 1.21
+++ TypeMap.pm 10 Jul 2004 00:36:19 -0000 1.22
@@ -293,7 +293,7 @@
my($name, $type) = ($e->{name}, $e->{type});
my $rtype;
- # ro/rw/undef(disabled)
+ # ro/rw/r+w_startup/undef(disabled)
my $access_mode = $self->structure_map->{$stype}->{$name};
next unless $access_mode;
next unless $rtype = $self->map_type($type);
1.78 +7 -1 modperl-2.0/lib/ModPerl/WrapXS.pm
Index: WrapXS.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -u -r1.77 -r1.78
--- WrapXS.pm 25 Jun 2004 15:29:25 -0000 1.77
+++ WrapXS.pm 10 Jul 2004 00:36:19 -0000 1.78
@@ -227,7 +227,12 @@
EOF
}
- elsif ($access_mode eq 'rw') {
+ elsif ($access_mode eq 'rw' or $access_mode eq 'r+w_startup') {
+
+ my $check_runtime = $access_mode eq 'rw'
+ ? ''
+ : qq[MP_CROAK_IF_THREADS_STARTED("setting $name");];
+
$code = <<EOF;
$type
$name(obj, val=$default)
@@ -242,6 +247,7 @@
RETVAL = ($cast) obj->$name;
if (items > 1) {
+ $check_runtime
obj->$name = ($cast) $val;
}
1.218 +34 -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.217
retrieving revision 1.218
diff -u -u -r1.217 -r1.218
--- mod_perl.c 7 Jul 2004 19:04:52 -0000 1.217
+++ mod_perl.c 10 Jul 2004 00:36:19 -0000 1.218
@@ -24,6 +24,18 @@
#define MP_IS_STARTING (MP_init_status == 1 ? 1 : 0)
#define MP_IS_RUNNING (MP_init_status == 2 ? 1 : 0)
+/* false while there is only the parent process and may be child
+ * processes, but no threads around, useful for allowing things that
+ * don't require locking and won't affect other threads. It should
+ * become true just before the child_init phase */
+static int MP_threads_started = 0;
+
+int modperl_threads_started(void)
+{
+ return MP_threads_started;
+}
+
+
#ifndef USE_ITHREADS
static apr_status_t modperl_shutdown(void *data)
{
@@ -31,6 +43,11 @@
PerlInterpreter *perl = (PerlInterpreter *)cdata->data;
void **handles;
+ /* reset for restarts */
+ if (scfg->threaded_mpm) {
+ MP_threads_started = 0;
+ }
+
handles = modperl_xs_dl_handles_get(aTHX);
MP_TRACE_i(MP_FUNC, "destroying interpreter=0x%lx\n",
@@ -613,6 +630,20 @@
return OK;
}
+static int modperl_hook_post_config_last(apr_pool_t *pconf, apr_pool_t *plog,
+ apr_pool_t *ptemp, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ /* in the threaded environment, no server_rec/process_rec
+ * modifications should be done beyond this point */
+ if (scfg->threaded_mpm) {
+ MP_threads_started = 1;
+ }
+
+ return OK;
+}
+
static int modperl_hook_create_request(request_rec *r)
{
MP_dRCFG;
@@ -729,6 +760,9 @@
ap_hook_post_config(modperl_hook_post_config,
NULL, NULL, APR_HOOK_FIRST);
+
+ ap_hook_post_config(modperl_hook_post_config_last,
+ NULL, NULL, APR_HOOK_REALLY_LAST);
ap_hook_handler(modperl_response_handler,
NULL, NULL, APR_HOOK_MIDDLE);
1.68 +8 -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.67
retrieving revision 1.68
diff -u -u -r1.67 -r1.68
--- mod_perl.h 25 Jun 2004 15:29:25 -0000 1.67
+++ mod_perl.h 10 Jul 2004 00:36:19 -0000 1.68
@@ -93,6 +93,14 @@
#include "modperl_module.h"
#include "modperl_debug.h"
+int modperl_threads_started(void);
+
+#define MP_CROAK_IF_THREADS_STARTED(what) \
+ if (modperl_threads_started()) { \
+ Perl_croak(aTHX_ "Can't run '%s' in the threaded " \
+ "environment after server startup", what); \
+ }
+
int modperl_init_vhost(server_rec *s, apr_pool_t *p,
server_rec *base_server);
void modperl_init(server_rec *s, apr_pool_t *p);
