Author: joes
Date: Tue Feb 22 13:56:49 2005
New Revision: 154900
URL: http://svn.apache.org/viewcvs?view=rev&rev=154900
Log:
Performance tuning for the perl glue: move the string
overloading ops out of the core APIs (body, args, jar).
Reserving them for the table-based APIs seems like a good
balance.
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm?view=diff&r1=154899&r2=154900
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm
(original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm Tue
Feb 22 13:56:49 2005
@@ -7,12 +7,12 @@
return &APR::Request::args, &APR::Request::body
if wantarray;
- my ($req, $key) = @_;
+ return &APR::Request::param
+ if @_ == 2;
- return APR::Request::params($req, $req->pool)
- if @_ == 1;
+ my $req = shift;
+ return APR::Request::params($req, $req->pool);
- return APR::Request::param($req, $key);
}
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm?view=diff&r1=154899&r2=154900
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
Tue Feb 22 13:56:49 2005
@@ -16,7 +16,7 @@
my $req = bless { r => $r };
$req->printf("method => %s\n", $req->method);
- $req->printf("cookie => %s\n", $req->cookies("apache")->as_string);
+ $req->printf("cookie => %s\n", $req->cookies->{"apache"}->as_string);
return 0;
}
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs?view=diff&r1=154899&r2=154900
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
Tue Feb 22 13:56:49 2005
@@ -48,7 +48,7 @@
if (items == 2 && GIMME_V == G_SCALAR) {
apreq_cookie_t *c = apreq_jar_get(req, SvPV_nolen(ST(1)));
if (c != NULL) {
- ST(0) = apreq_xs_cookie2sv(aTHX_ c, COOKIE_CLASS, obj);
+ ST(0) = apreq_xs_cookie2sv(aTHX_ c, NULL, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -76,7 +76,7 @@
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = COOKIE_CLASS;
+ d.pkg = NULL;
d.parent = obj;
switch (GIMME_V) {
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs?view=diff&r1=154899&r2=154900
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
Tue Feb 22 13:56:49 2005
@@ -1,7 +1,6 @@
#include "apreq_xs_tables.h"
#define TABLE_CLASS "APR::Request::Param::Table"
-
static int apreq_xs_table_keys(void *data, const char *key, const char *val)
{
struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
@@ -51,7 +50,7 @@
apreq_param_t *p = apreq_args_get(req, SvPV_nolen(ST(1)));
if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, PARAM_CLASS, obj);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -79,7 +78,7 @@
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = PARAM_CLASS;
+ d.pkg = NULL;
d.parent = obj;
switch (GIMME_V) {
@@ -95,8 +94,8 @@
return;
case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
- PARAM_CLASS, sizeof(PARAM_CLASS)-1);
+ ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
+ PARAM_CLASS, sizeof(PARAM_CLASS) -1);
sv_2mortal(ST(0));
XSRETURN(1);
@@ -127,7 +126,7 @@
apreq_param_t *p = apreq_body_get(req, SvPV_nolen(ST(1)));
if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, PARAM_CLASS, obj);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -155,7 +154,7 @@
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = PARAM_CLASS;
+ d.pkg = NULL;
d.parent = obj;
switch (GIMME_V) {
@@ -447,7 +446,7 @@
req = INT2PTR(apreq_handle_t *, iv);
t = apreq_params(req, pool);
RETVAL = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
- PARAM_CLASS, sizeof(PARAM_CLASS)-1);
+ PARAM_CLASS, sizeof(PARAM_CLASS)-1);
OUTPUT:
RETVAL
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h?view=diff&r1=154899&r2=154900
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
Tue Feb 22 13:56:49 2005
@@ -141,6 +141,14 @@
static SV *apreq_xs_param2sv(pTHX_ apreq_param_t *p,
const char *class, SV *parent)
{
+ if (class == NULL) {
+ SV *rv = newSVpvn(p->v.data, p->v.size);
+ if (apreq_param_is_tainted(p))
+ SvTAINTED_on(rv);
+ /*XXX add charset fixups */
+ return rv;
+ }
+
return apreq_xs_object2sv(aTHX_ p, class, parent, PARAM_CLASS);
}
@@ -148,6 +156,14 @@
static SV *apreq_xs_cookie2sv(pTHX_ apreq_cookie_t *c,
const char *class, SV *parent)
{
+ if (class == NULL) {
+ SV *rv = newSVpvn(c->v.data, c->v.size);
+ if (apreq_cookie_is_tainted(c))
+ SvTAINTED_on(rv);
+ /*XXX add charset fixups? */
+ return rv;
+ }
+
return apreq_xs_object2sv(aTHX_ c, class, parent, COOKIE_CLASS);
}
@@ -158,11 +174,13 @@
SV *obj;
MAGIC *mg;
sv = apreq_xs_find_obj(aTHX_ sv, attr);
+
+ /* XXX sv_derived_from is expensive; how to optimize it? */
if (sv_derived_from(sv, class)) {
return SvRV(sv);
}
- /* check if parent (mg->mg_obj) is a handle */
+ /* else check if parent (mg->mg_obj) is the right object type */
if ((mg = mg_find(SvRV(sv), PERL_MAGIC_ext)) != NULL
&& (obj = mg->mg_obj) != NULL
&& SvOBJECT(obj))
