dougm 2003/01/10 16:02:17
Modified: src/modules/perl modperl_util.c modperl_util.h
xs/Apache/RequestUtil Apache__RequestUtil.h
xs/tables/current/ModPerl FunctionTable.pm
Log:
sv_str_header needs to be passed the current aTHX to avoid a pile of
calls to the expensive dTHX; in $r->as_string. also needed to
s/sv_catpvf/Perl_sv_catpvf for the -DPERL_CORE optimization.
have made sv_str_header private to Apache__RequestUtil.h in the
process, as the usage is ugly with THX; can re-{think,expose} later if
it turns out to be needed elsewhere.
Revision Changes Path
1.50 +0 -7 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- modperl_util.c 6 Dec 2002 16:19:36 -0000 1.49
+++ modperl_util.c 11 Jan 2003 00:02:16 -0000 1.50
@@ -615,10 +615,3 @@
return rv;
}
-int modperl_sv_str_header(void *arg, const char *k, const char *v)
-{
- SV *sv = (SV*)arg;
- sv_catpvf(sv, "%s: %s\n", k, v);
- return 1;
-}
-
1.37 +0 -2 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- modperl_util.h 6 Dec 2002 16:19:36 -0000 1.36
+++ modperl_util.h 11 Jan 2003 00:02:16 -0000 1.37
@@ -118,7 +118,5 @@
MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name);
SV *modperl_perl_gensym(pTHX_ char *pack);
-
-int modperl_sv_str_header(void *arg, const char *k, const char *v);
#endif /* MODPERL_UTIL_H */
1.15 +26 -8 modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h
Index: Apache__RequestUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- Apache__RequestUtil.h 10 Jan 2003 23:32:33 -0000 1.14
+++ Apache__RequestUtil.h 11 Jan 2003 00:02:16 -0000 1.15
@@ -215,25 +215,43 @@
return dcfg->location;
}
+typedef struct {
+ PerlInterpreter *perl;
+ SV *sv;
+} sv_str_header_t;
+
+static int sv_str_header(void *arg, const char *k, const char *v)
+{
+ sv_str_header_t *svh = (sv_str_header_t *)arg;
+ dTHXa(svh->perl);
+ Perl_sv_catpvf(aTHX_ svh->sv, "%s: %s\n", k, v);
+ return 1;
+}
+
static MP_INLINE
SV *mpxs_Apache__RequestRec_as_string(pTHX_ request_rec *r)
{
- SV *retval = newSVpv(r->the_request, 0);
+ sv_str_header_t svh;
+#ifdef USE_ITHREADS
+ svh.perl = aTHX;
+#endif
+
+ svh.sv = newSVpv(r->the_request, 0);
- sv_catpvn(retval, "\n", 1);
+ sv_catpvn(svh.sv, "\n", 1);
apr_table_do((int (*) (void *, const char *, const char *))
- modperl_sv_str_header, (void *) retval, r->headers_in, NULL);
+ sv_str_header, (void *) &svh, r->headers_in, NULL);
- Perl_sv_catpvf(aTHX_ retval, "\n%s %s\n", r->protocol, r->status_line);
+ Perl_sv_catpvf(aTHX_ svh.sv, "\n%s %s\n", r->protocol, r->status_line);
apr_table_do((int (*) (void *, const char *, const char *))
- modperl_sv_str_header, (void *) retval, r->headers_out, NULL);
+ sv_str_header, (void *) &svh, r->headers_out, NULL);
apr_table_do((int (*) (void *, const char *, const char *))
- modperl_sv_str_header, (void *) retval, r->err_headers_out, NULL);
+ sv_str_header, (void *) &svh, r->err_headers_out, NULL);
- sv_catpvn(retval, "\n", 1);
+ sv_catpvn(svh.sv, "\n", 1);
- return retval;
+ return svh.sv;
}
1.90 +0 -18 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -r1.89 -r1.90
--- FunctionTable.pm 12 Dec 2002 10:05:08 -0000 1.89
+++ FunctionTable.pm 11 Jan 2003 00:02:16 -0000 1.90
@@ -3831,24 +3831,6 @@
]
},
{
- 'return_type' => 'int',
- 'name' => 'modperl_sv_str_header',
- 'args' => [
- {
- 'type' => 'void *',
- 'name' => 'arg'
- },
- {
- 'type' => 'const char *',
- 'name' => 'k'
- },
- {
- 'type' => 'const char *',
- 'name' => 'v'
- },
- ]
- },
- {
'return_type' => 'apr_pool_t *',
'name' => 'modperl_sv2pool',
'args' => [
