hi all
we have this in our todo/release:
* Apache->server_root_relative:
needs to default to current pool (pconf at startup, r->pool at
request time) - solution: require the pool object to be passed. if a
user doesn't have one, make them create one, e.g.:
Apache::server_root_relative(APR::Pool->new, ....). Must make sure
that the returned SV has a copy of that string and doesn't rely on
anything that it's in pool, which will be now destroyed.
as far as I can tell, this makes Apache::server_root_relative() behave
exactly like ap_server_root_relative() wrt requiring a pool.
so, it looks to me like mod_perl doesn't need to intervene on this call at
anymore, but I wanted to make sure I haven't missed something vital before a
commit. the comments made me nervous, since I couldn't remember if the
discussion at apachecon was that the SV definitely needed to be a copy, or
if it just needed to be checked for integrity - I traced the pool calls back
and didn't see anything that seemed to require the pool stick around, but
I'm not entirely sure I'm looking at it right.
anyway, I added a few tests, including one that destroys the pool then
attempts to reuse the SV. everything passes for me on worker, including
t/SMOKE but I could use another set of eyes.
--Geoff
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.94
diff -u -r1.94 compat.pm
--- lib/Apache/compat.pm 20 Dec 2003 01:28:43 -0000 1.94
+++ lib/Apache/compat.pm 8 Jan 2004 19:28:58 -0000
@@ -210,7 +210,9 @@
package Apache::Server;
# XXX: is that good enough? see modperl/src/modules/perl/mod_perl.c:367
-our $CWD = Apache->server_root_relative();
+# use APR::Pool->new since we don't can't know ahead of time
+# where we will be called from
+our $CWD = Apache::server_root_relative(APR::Pool->new);
our $AddPerlVersion = 1;
@@ -335,8 +337,11 @@
$r->content_type($type);
}
-#to support $r->server_root_relative
-*server_root_relative = \&Apache::server_root_relative;
+sub server_root_relative {
+ my $r = shift;
+
+ return Apache::server_root_relative($r->pool, @_);
+}
#we support Apache->request; this is needed to support $r->request
#XXX: seems sorta backwards
Index: t/response/TestAPI/server_util.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPI/server_util.pm,v
retrieving revision 1.5
diff -u -r1.5 server_util.pm
--- t/response/TestAPI/server_util.pm 11 Apr 2002 11:08:43 -0000 1.5
+++ t/response/TestAPI/server_util.pm 8 Jan 2004 19:28:58 -0000
@@ -5,9 +5,11 @@
use Apache::Test;
use Apache::TestUtil;
+use File::Spec::Functions qw(catfile);
use Apache::RequestRec ();
use Apache::ServerUtil ();
+use Apache::Process ();
use Apache::Const -compile => 'OK';
@@ -16,30 +18,39 @@
my $s = $r->server;
- plan $r, tests => 9;
+ plan $r, tests => 8;
for my $p ($r->pool, $r->connection->pool,
- $r, $r->connection, $r->server)
+ $r->server->process->pconf)
{
my $dir = Apache::server_root_relative($p, 'conf');
ok -d $dir;
}
- my $dir = Apache::server_root; #constant
+ # test that a pool with a short lifetime doesn't mess up things
+ {
+ my $p = APR::Pool->new;
- ok -d $dir;
+ my $dir = Apache::server_root_relative($p, 'conf');
- $dir = join '/', Apache::server_root, 'logs';
+ ok -d $dir;
- ok $dir eq Apache::server_root_relative($r->pool, 'logs');
+ $p->destroy;
+
+ ok -d $dir;
+ }
- $dir = Apache->server_root_relative('logs'); #1.x ish
+ my $dir = Apache::server_root; #constant
ok -d $dir;
- #$r->server_root_relative works with use Apache::compat
- $dir = Apache->server_root_relative(); #1.x ish
+ $dir = catfile(Apache::server_root, 'logs');
+
+ ok $dir eq Apache::server_root_relative($r->pool, 'logs');
+
+ # $r->server_root_relative works with use Apache::compat
+ $dir = Apache::server_root_relative($r->pool);
ok -d $dir;
Index: t/response/TestAPR/finfo.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/finfo.pm,v
retrieving revision 1.7
diff -u -r1.7 finfo.pm
--- t/response/TestAPR/finfo.pm 16 Dec 2003 18:13:04 -0000 1.7
+++ t/response/TestAPR/finfo.pm 8 Jan 2004 19:28:58 -0000
@@ -40,7 +40,8 @@
ok $isa;
}
- my $file = Apache->server_root_relative(catfile qw(htdocs index.html));
+ my $file = Apache::server_root_relative($r->pool,
+ catfile qw(htdocs index.html));
# stat tests
{
Index: todo/release
===================================================================
RCS file: /home/cvspublic/modperl-2.0/todo/release,v
retrieving revision 1.6
diff -u -r1.6 release
--- todo/release 19 Dec 2003 01:17:32 -0000 1.6
+++ todo/release 8 Jan 2004 19:28:58 -0000
@@ -139,14 +139,6 @@
http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=100622977803237&w=2
http://marc.theaimsgroup.com/?t=97984528900002&r=1&w=2
-* Apache->server_root_relative:
- needs to default to current pool (pconf at startup, r->pool at
- request time) - solution: require the pool object to be passed. if a
- user doesn't have one, make them create one, e.g.:
- Apache::server_root_relative(APR::Pool->new, ....). Must make sure
- that the returned SV has a copy of that string and doesn't rely on
- anything that it's in pool, which will be now destroyed.
-
* $r->cleanup_for_exec needs to be added to Apache::compat as a noop.
Owner: stas
Index: xs/Apache/ServerUtil/Apache__ServerUtil.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/Apache/ServerUtil/Apache__ServerUtil.h,v
retrieving revision 1.8
diff -u -r1.8 Apache__ServerUtil.h
--- xs/Apache/ServerUtil/Apache__ServerUtil.h 19 Nov 2001 23:46:48 -0000 1.8
+++ xs/Apache/ServerUtil/Apache__ServerUtil.h 8 Jan 2004 19:28:59 -0000
@@ -42,15 +42,6 @@
#define mpxs_Apache_server(classname) \
modperl_global_get_server_rec()
-static MP_INLINE char *mpxs_ap_server_root_relative(pTHX_
- SV *sv,
- const char *fname)
-{
- apr_pool_t *p = modperl_sv2pool(aTHX_ sv);
-
- return ap_server_root_relative(p, fname);
-}
-
static void mpxs_Apache__ServerUtil_BOOT(pTHX)
{
newCONSTSUB(PL_defstash, "Apache::server_root",
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.66
diff -u -r1.66 apache_functions.map
--- xs/maps/apache_functions.map 1 Dec 2003 17:14:16 -0000 1.66
+++ xs/maps/apache_functions.map 8 Jan 2004 19:28:59 -0000
@@ -166,7 +166,7 @@
ap_get_server_built
ap_get_server_version
ap_psignature | | r,prefix
- ap_server_root_relative | mpxs_ | SV *:p, fname=""
+ ap_server_root_relative | | p, fname=""
MODULE=Apache::Connection PACKAGE=guess
#XXX: thought this might be useful for protocol modules
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.134
diff -u -r1.134 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 23 Dec 2003 03:02:34 -0000 1.134
+++ xs/tables/current/ModPerl/FunctionTable.pm 8 Jan 2004 19:28:59 -0000
@@ -6281,28 +6281,6 @@
},
{
'return_type' => 'char *',
- 'name' => 'mpxs_ap_server_root_relative',
- 'attr' => [
- 'static',
- '__inline__'
- ],
- 'args' => [
- {
- 'type' => 'PerlInterpreter *',
- 'name' => 'my_perl'
- },
- {
- 'type' => 'SV *',
- 'name' => 'sv'
- },
- {
- 'type' => 'const char *',
- 'name' => 'fname'
- }
- ]
- },
- {
- 'return_type' => 'char *',
'name' => 'mpxs_ap_unescape_url',
'attr' => [
'static',
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
