perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject [patch] $r->document_root & thread mutex locking
Date Mon, 03 Dec 2001 09:59:53 GMT
Added per-server configuration mutex locking, when changing things
like document_root.

I had to pick between Perl mutex and APR mutex. Since the tipool
stuff already uses one Perl mutex, I decided to stay consistent.

Works fine for me.

/home/gozer/sources/mod_perl2/deps/perl-13432/bin/perl build/cvsdiff 
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_config.c,v
retrieving revision 1.51
diff -u -I'$Id' -I'$Revision' -r1.51 modperl_config.c
--- src/modules/perl/modperl_config.c	20 Nov 2001 02:39:02 -0000	1.51
+++ src/modules/perl/modperl_config.c	3 Dec 2001 09:50:32 -0000
@@ -115,6 +115,8 @@
     scfg->SetEnv = apr_table_make(p, 2);
     
     modperl_config_srv_argv_push((char *)ap_server_argv0);
+    
+    MP_MUTEX_INIT(scfg);
 
     MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)scfg);
 

Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.11
diff -u -I'$Id' -I'$Revision' -r1.11 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h	13 Nov 2001 17:42:49 -0000	1.11
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h	3 Dec 2001 09:50:32 -0000
@@ -214,3 +214,21 @@
 
     return dcfg->location;
 }
+
+static MP_INLINE
+const char *mpxs_Apache__RequestRec_document_root(request_rec *r, 
+                                                  char *document_root)
+{
+    MP_dSCFG(r->server);
+    core_server_config *sconf = 
+            ap_get_module_config(r->server->module_config,              
+                                 &core_module);
+
+    if (document_root) {
+        MP_MUTEX_LOCK(scfg);
+        sconf->ap_document_root = document_root;
+        MP_MUTEX_UNLOCK(scfg);
+    }
+    
+    return sconf->ap_document_root;
+}

Index: src/modules/perl/modperl_types.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_types.h,v
retrieving revision 1.54
diff -u -I'$Id' -I'$Revision' -r1.54 modperl_types.h
--- src/modules/perl/modperl_types.h	19 Nov 2001 00:07:28 -0000	1.54
+++ src/modules/perl/modperl_types.h	3 Dec 2001 09:50:32 -0000
@@ -36,6 +36,7 @@
 typedef struct modperl_interp_t modperl_interp_t;
 typedef struct modperl_interp_pool_t modperl_interp_pool_t;
 typedef struct modperl_tipool_t modperl_tipool_t;
+typedef perl_mutex modperl_mutex_t;
 
 struct modperl_interp_t {
     modperl_interp_pool_t *mip;
@@ -125,6 +126,7 @@
     modperl_interp_pool_t *mip;
     modperl_tipool_config_t *interp_pool_cfg;
     modperl_interp_scope_e interp_scope;
+    modperl_mutex_t mutex;
 #else
     PerlInterpreter *perl;
 #endif

Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_config.h,v
retrieving revision 1.30
diff -u -I'$Id' -I'$Revision' -r1.30 modperl_config.h
--- src/modules/perl/modperl_config.h	5 Nov 2001 05:19:01 -0000	1.30
+++ src/modules/perl/modperl_config.h	3 Dec 2001 09:50:32 -0000
@@ -89,6 +89,16 @@
 #   define MP_dSCFG_dTHX dTHXa(scfg->perl)
 #endif
 
+#ifdef USE_ITHREADS
+#   define MP_MUTEX_LOCK(m) MUTEX_LOCK(&m->mutex)
+#   define MP_MUTEX_UNLOCK(m) MUTEX_UNLOCK(&m->mutex);
+#   define MP_MUTEX_INIT(m) MUTEX_INIT(&m->mutex)
+#else
+#   define MP_MUTEX_LOCK(m) NOOP
+#   define MP_MUTEX_UNLOCK(m) MUTEX_UNLOCK(m) NOOP
+#   define MP_MUTEX_INIT(m) NOOP
+#endif
+
 /* hopefully this macro will not need to be used often */
 #ifdef USE_ITHREADS
 #   define MP_dTHX \

Index: t/response/TestAPI/rutil.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPI/rutil.pm,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 rutil.pm
--- t/response/TestAPI/rutil.pm	22 May 2001 20:57:44 -0000	1.2
+++ t/response/TestAPI/rutil.pm	3 Dec 2001 09:50:32 -0000
@@ -27,11 +27,19 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 17;
+    plan $r, tests => 19;
 
     ok $r->default_type;
 
     ok $r->document_root;
+    
+    my $document_root = $r->document_root;
+    
+    ok $r->document_root("/foo/bar") && 
+        ( $r->document_root eq "/foo/bar" );
+        
+    ok $r->document_root($document_root) &&
+        ( $r->document_root eq $document_root );
 
     ok $r->get_server_name;
 

Index: docs/src/api/mod_perl-2.0/Apache/RequestRec.pod
===================================================================
RCS file: /home/anoncvs/mod_perl-docs-cvs/src/api/mod_perl-2.0/Apache/RequestRec.pod,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 RequestRec.pod
--- docs/src/api/mod_perl-2.0/Apache/RequestRec.pod	10 Oct 2001 05:06:36 -0000	1.2
+++ docs/src/api/mod_perl-2.0/Apache/RequestRec.pod	3 Dec 2001 09:50:32 -0000
@@ -8,6 +8,7 @@
   sub handler{
       my $r = shift;
       
+      my $dir = $r->document_root;
       my $s = $r->server;
       my $dir_config = $r->dir_config;
       ...
@@ -23,6 +24,21 @@
 function's synopsis.
 
 =over
+
+=item * document_root()
+
+  $dir = $r->document_root;
+  $r->document_root("/new/document/root");
+  
+Returns the current value of the per server  configuration directive 
+B<DocumentRoot>. To quote the Apache server documentation, "Unless matched
+by a directive like Alias, the server appends the path from the 
+requested URL to the document root to make the path to the document." 
+This same value is passed to CGI scripts in the `DOCUMENT_ROOT' 
+environment variable.
+
+If passed an argument, sets the B<DocumentRoot> of the current server 
+or virtual host.
 
 =item * server()
 

Index: todo/api.txt
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
retrieving revision 1.16
diff -u -I'$Id' -I'$Revision' -r1.16 api.txt
--- todo/api.txt	13 Nov 2001 17:42:49 -0000	1.16
+++ todo/api.txt	3 Dec 2001 09:50:33 -0000
@@ -43,10 +43,6 @@
 exists as Apache::exists_config_define, which should stay,
 Apache::compat could implement a wrapper.
 
-$r->document_root:
-cannot currently be modified.  requires locking since it is part of
-the per-server config structure which is shared between threads
-
 $r->send_fd:
 need to figure out howto map PerlIO <-> apr_file_t
 at the moment $r->send_fd is implement in Apache::compat, functions,

Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apache_functions.map,v
retrieving revision 1.39
diff -u -I'$Id' -I'$Revision' -r1.39 apache_functions.map
--- xs/maps/apache_functions.map	19 Nov 2001 23:46:48 -0000	1.39
+++ xs/maps/apache_functions.map	3 Dec 2001 09:50:33 -0000
@@ -48,7 +48,7 @@
 >ap_process_request_internal
 
 #MODULE=Apache::RequestConfig
- ap_document_root
+ mpxs_Apache__RequestRec_document_root | | r, document_root=NULL
  ap_get_limit_req_body
 ?ap_get_limit_xml_body
 >ap_core_translate


-- 
Philippe M. Chiasson  <gozer@cpan.org>
  Extropia's Resident System Guru
     http://www.eXtropia.com/


perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl Hacker!\n$/&&print||$$++&&redo}'

Mime
View raw message