ok, here's another pass - I think it covers what we talked about this
afternoon on irc.
it won't apply over the is_perl_option_enabled stuff you just posted, so
I'll wait until monday to rework it into core and commit, even if there are
no technical changes to be made.
if you have any ideas on a better way to phrase Changes, I'm all ears.
--Geoff
Index: Changes
===================================================================
RCS file: /home/cvspublic/modperl-2.0/Changes,v
retrieving revision 1.297
diff -u -r1.297 Changes
--- Changes 3 Jan 2004 01:17:33 -0000 1.297
+++ Changes 10 Jan 2004 02:46:07 -0000
@@ -11,6 +11,8 @@
=over 3
=item 1.99_13-dev
+server_root_relative() will now derive the pool if called from
+$r, $s, or $c objects. [Geoffrey Young]
On Solaris add a workaround for xs/APR/APR/Makefile.PL to build
APR.so, correctly linked against apr and apr-util libs, by addding the
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.59
diff -u -r1.59 modperl_util.c
--- src/modules/perl/modperl_util.c 19 Dec 2003 01:17:32 -0000 1.59
+++ src/modules/perl/modperl_util.c 10 Jan 2004 02:46:07 -0000
@@ -194,6 +194,12 @@
return modperl_global_get_pconf();
}
+ /* $r->server_root_relative($name), or
+ * Apache->server_root_relative($p, $name)
+ *
+ * for $(r|c|s) dig out the pool from the record
+ * otherwise use the pool provided
+ */
if ((SvROK(obj) && (SvTYPE(SvRV(obj)) == SVt_PVMG))) {
ptr = SvObjIV(obj);
classname = SvCLASS(obj);
@@ -204,8 +210,13 @@
}
if (*classname != 'A') {
- /* XXX: could be a subclass */
- return NULL;
+ /* XXX: could be a subclass, but more likely
+ * Apache::server_root_relative($name);
+ * note no -> so $name is the class
+ * avoid core dumps by returning the global pool,
+ * even though it then gives just the ServerRoot back
+ */
+ return modperl_global_get_pconf();
}
if (strnEQ(classname, "APR::", 5)) {
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 10 Jan 2004 02:46:07 -0000
@@ -5,43 +5,96 @@
use Apache::Test;
use Apache::TestUtil;
+use File::Spec::Functions qw(canonpath catfile);
use Apache::RequestRec ();
use Apache::ServerUtil ();
+use Apache::Process ();
-use Apache::Const -compile => 'OK';
+use APR::Pool ();
-sub handler {
- my $r = shift;
+use Apache::Const -compile => 'OK';
- my $s = $r->server;
+my $serverroot = Apache::Test::config()->{vars}->{serverroot};
- plan $r, tests => 9;
+sub handler {
- for my $p ($r->pool, $r->connection->pool,
- $r, $r->connection, $r->server)
- {
- my $dir = Apache::server_root_relative($p, 'conf');
+ my $r = shift;
- ok -d $dir;
+ my %pools = ( '$r->pool' => $r->pool,
+ '$r->connection->pool' => $r->connection->pool,
+ '$r->server->process->pool' => $r->server->process->pool,
+ '$r->server->process->pconf' => $r->server->process->pconf,
+ 'APR::Pool->new' => APR::Pool->new,
+ );
+
+ my %objects = ( '$r' => $r,
+ '$r->connection' => $r->connection,
+ '$r->server' => $r->server,
+ );
+
+ plan $r, tests => (scalar keys %pools) +
+ (scalar keys %objects) + 7;
+
+ # pass a pool directly to the function call
+ foreach my $p (keys %pools) {
+
+ ok t_cmp(catfile($serverroot, 'conf'),
+ Apache::server_root_relative($pools{$p}, 'conf'),
+ "Apache::server_root_relative($p, 'conf')");
}
- my $dir = Apache::server_root; #constant
-
- ok -d $dir;
-
- $dir = join '/', Apache::server_root, 'logs';
+ # dig out the pool from the core objects
+ foreach my $obj (keys %objects) {
- ok $dir eq Apache::server_root_relative($r->pool, 'logs');
+ t_debug("$obj->server_root_relative('conf')");
- $dir = Apache->server_root_relative('logs'); #1.x ish
+ ok t_cmp(catfile($serverroot, 'conf'),
+ $objects{$obj}->server_root_relative('conf'),
+ "$obj->server_root_relative('conf')");
+ }
- ok -d $dir;
+ # no real class - uses global pool
+ ok t_cmp(catfile($serverroot, 'conf'),
+ Apache->server_root_relative('conf'),
+ "Apache->server_root_relative('conf')");
+
+ # no file argument gives ServerRoot
+ ok t_cmp(canonpath($serverroot),
+ canonpath(Apache->server_root_relative),
+ 'Apache->server_root_relative()');
+
+ ok t_cmp(canonpath($serverroot),
+ canonpath($r->server_root_relative),
+ '$r->server_root_relative()');
+
+ # Apache::server_root is also the ServerRoot constant
+ ok t_cmp(canonpath(Apache::server_root),
+ canonpath($r->server_root_relative),
+ 'Apache::server_root');
+
+ # a class or pool is required
+ t_debug("Apache::server_root_relative() died");
+ eval { my $dir = Apache::server_root_relative() };
+ ok $@;
+
+ # XXX 'conf' is not an object or class, so we use
+ # the global pool. in the process 'conf' is soaked up
+ # and we act as though we were called with no args
+ my $dir = Apache::server_root_relative('conf');
+
+ ok t_cmp(Apache->server_root_relative,
+ Apache::server_root_relative('conf'),
+ "Apache::server_root_relative('conf')");
- #$r->server_root_relative works with use Apache::compat
- $dir = Apache->server_root_relative(); #1.x ish
+ {
+ # absolute paths should resolve to themselves
+ my $dir = $r->server_root_relative('logs');
- ok -d $dir;
+ ok t_cmp($r->server_root_relative($dir),
+ $dir,
+ "\$r->server_root_relative($dir)");
+ }
Apache::OK;
}
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 10 Jan 2004 02:46:07 -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 10 Jan 2004 02:46:07 -0000
@@ -42,13 +42,37 @@
#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)
+static MP_INLINE SV *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);
+ return newSVpv(ap_server_root_relative(p, fname), 0);
+}
+
+static MP_INLINE
+SV *mpxs_Apache__RequestRec_server_root_relative(pTHX_
+ SV *sv,
+ const char *fname)
+{
+ return mpxs_ap_server_root_relative(aTHX_ sv, fname);
+}
+
+static MP_INLINE
+SV *mpxs_Apache__Server_server_root_relative(pTHX_
+ SV *sv,
+ const char *fname)
+{
+ return mpxs_ap_server_root_relative(aTHX_ sv, fname);
+}
+
+static MP_INLINE
+SV *mpxs_Apache__Connection_server_root_relative(pTHX_
+ SV *sv,
+ const char *fname)
+{
+ return mpxs_ap_server_root_relative(aTHX_ sv, fname);
}
static void mpxs_Apache__ServerUtil_BOOT(pTHX)
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.63
diff -u -r1.63 modperl_functions.map
--- xs/maps/modperl_functions.map 23 Dec 2003 03:02:34 -0000 1.63
+++ xs/maps/modperl_functions.map 10 Jan 2004 02:46:07 -0000
@@ -69,8 +69,15 @@
mpxs_Apache__Server_get_handlers
modperl_config_insert_server | | | add_config
+PACKAGE=Apache::RequestRec
+ mpxs_Apache__RequestRec_server_root_relative | | SV *:p, fname=""
+
PACKAGE=Apache::Server
SV *:DEFINE_dir_config | | server_rec *:s, char *:key=NULL, SV *:sv_val=Nullsv
+ mpxs_Apache__Server_server_root_relative | | SV *:p, fname=""
+
+PACKAGE=Apache::Connection
+ mpxs_Apache__Connection_server_root_relative | | SV *:p, fname=""
PACKAGE=Apache
server_rec *:DEFINE_server | | SV *:classname=Nullsv
Index: xs/tables/current/Apache/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/FunctionTable.pm,v
retrieving revision 1.51
diff -u -r1.51 FunctionTable.pm
--- xs/tables/current/Apache/FunctionTable.pm 8 Dec 2003 19:31:53 -0000 1.51
+++ xs/tables/current/Apache/FunctionTable.pm 10 Jan 2004 02:46:08 -0000
@@ -4724,7 +4724,7 @@
]
},
{
- 'return_type' => 'char *',
+ 'return_type' => 'SV *',
'name' => 'ap_server_root_relative',
'args' => [
{
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 10 Jan 2004 02:46:08 -0000
@@ -6280,7 +6280,7 @@
]
},
{
- 'return_type' => 'char *',
+ 'return_type' => 'SV *',
'name' => 'mpxs_ap_server_root_relative',
'attr' => [
'static',
@@ -6294,6 +6294,72 @@
{
'type' => 'SV *',
'name' => 'sv'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'fname'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_Apache__RequestRec_server_root_relative',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'p'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'fname'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_Apache__Server_server_root_relative',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'p'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'fname'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_Apache__Connection_server_root_relative',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'p'
},
{
'type' => 'const char *',
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
