Author: joes
Date: Mon Feb 21 07:30:26 2005
New Revision: 154681
URL: http://svn.apache.org/viewcvs?view=rev&rev=154681
Log:
Alias get and FETCH for tables.
Add methods: make(), param_class() and cookie_class().
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/cookie.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/param.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
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL?view=diff&r1=154680&r2=154681
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL Mon Feb 21
07:30:26 2005
@@ -514,17 +514,25 @@
sub typemap_code
{
{
+ T_SUBCLASS => {
+ INPUT => <<'EOT',
+ if (SvROK($arg) || !sv_derived_from($arg, \"$Package\"))
+ Perl_croak(aTHX_ \"Usage: argument is not a subclass of $Package\");
+ $var = SvPV_nolen($arg)
+EOT
+ },
+
T_APREQ_COOKIE => {
- INPUT => '$var = apreq_xs_sv2(cookie,$arg)',
- perl2c => 'apreq_xs_sv2(cookie,sv)',
- OUTPUT => '$arg =
apreq_xs_2sv($var,"\${ntype}\");',
- c2perl => 'apreq_xs_2sv(ptr,\"$class\")',
+ INPUT => '$var = apreq_xs_sv2cookie(aTHX_ $arg)',
+ perl2c => 'apreq_xs_sv2cookie(aTHX_ sv)',
+ OUTPUT => '$arg = apreq_xs_cookie2sv(aTHX_ $var,
class, parent);',
+ c2perl => 'apreq_xs_cookie2sv(aTHX_ ptr, class,
parent)',
},
T_APREQ_PARAM => {
- INPUT => '$var = apreq_xs_sv2param($arg)',
- perl2c => 'apreq_xs_sv2param(sv)',
- OUTPUT => '$arg = apreq_xs_param2sv($var);',
- c2perl => 'apreq_xs_param2sv(ptr)',
+ INPUT => '$var = apreq_xs_sv2param(aTHX_ $arg)',
+ perl2c => 'apreq_xs_sv2param(aTHX_ sv)',
+ OUTPUT => '$arg = apreq_xs_param2sv(aTHX_ $var,
class, parent);',
+ c2perl => 'apreq_xs_param2sv(aTHX_ ptr, class,
parent)',
},
T_APREQ_HANDLE => {
INPUT => '$var = apreq_xs_perl2c(aTHX_ $arg,
\"r\")',
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/cookie.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/cookie.pm?view=diff&r1=154680&r2=154681
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/cookie.pm
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/cookie.pm
Mon Feb 21 07:30:26 2005
@@ -1,5 +1,5 @@
package TestAPI::cookie;
-
+push our @ISA, "APR::Request::Cookie";
use strict;
use warnings FATAL => 'all';
@@ -12,7 +12,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 26;
+ plan $r, tests => 28;
$r->headers_in->{Cookie} = "foo=1;bar=2;foo=3;quux=4";
my $req = APR::Request::Apache2->new($r);
@@ -49,6 +49,12 @@
ok t_cmp $_->tainted, 1, "is tainted: $_" for values %$jar;
$_->tainted(0) for values %$jar;
ok t_cmp $_->tainted, 0, "not tainted: $_" for values %$jar;
+
+ eval { $jar->cookie_class("APR::Request::Param") };
+ ok t_cmp qr/^Usage/, $@, "Bad class name";
+
+ $jar->cookie_class(__PACKAGE__);
+ ok $jar->{foo}->isa(__PACKAGE__);
return 0;
}
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/param.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/param.pm?view=diff&r1=154680&r2=154681
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/param.pm
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestAPI/param.pm
Mon Feb 21 07:30:26 2005
@@ -1,4 +1,5 @@
package TestAPI::param;
+push our @ISA, "APR::Request::Param";
use strict;
use warnings FATAL => 'all';
@@ -12,7 +13,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 26;
+ plan $r, tests => 28;
$r->args("foo=1;bar=2;foo=3;quux=4");
my $req = APR::Request::Apache2->new($r);
@@ -48,6 +49,13 @@
ok t_cmp $_->tainted, 1, "is tainted: $_" for values %$args;
$_->tainted(0) for values %$args;
ok t_cmp $_->tainted, 0, "not tainted: $_" for values %$args;
+
+
+ eval { $args->param_class("APR::Request::Cookie") };
+ ok t_cmp qr/^Usage/, $@, "Bad class name";
+
+ $args->param_class(__PACKAGE__);
+ ok $args->{foo}->isa(__PACKAGE__);
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=154680&r2=154681
==============================================================================
---
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
Mon Feb 21 07:30:26 2005
@@ -1,19 +1,31 @@
#include "apreq_xs_tables.h"
+#define TABLE_CLASS "APR::Request::Cookie::Table"
+#define COOKIE_CLASS "APR::Request::Cookie"
+#define ERROR_CLASS "APR::Request::Error"
static APR_INLINE
-SV *apreq_xs_cookie2sv(pTHX_ apreq_cookie_t *c, const char *class, SV *handle)
+SV *apreq_xs_cookie2sv(pTHX_ apreq_cookie_t *c, const char *class, SV *parent)
{
+
SV *rv = sv_setref_pv(newSV(0), class, (void *)c);
- sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, Nullch, 0);
return rv;
}
static APR_INLINE
-SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV
*handle)
+apreq_cookie_t *apreq_xs_sv2cookie(pTHX_ SV *sv)
+{
+ IV iv = SvIVX(SvRV(sv));
+ return INT2PTR(apreq_cookie_t *, iv);
+}
+
+static APR_INLINE
+SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV
*handle,
+ const char *cookie_class, I32 clen)
{
SV *sv = (SV *)newHV();
SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
- sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, cookie_class, clen);
#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
@@ -61,13 +73,11 @@
{
dXSARGS;
apreq_handle_t *req;
- const char *error_pkg = "APR::Request::Error",
- *jar_pkg = "APR::Request::Cookie::Table",
- *cookie_pkg = "APR::Request::Cookie";
SV *sv, *obj;
IV iv;
- if (items == 0 || items > 2 || !SvROK(ST(0)))
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), "APR::Request"))
Perl_croak(aTHX_ "Usage: APR::Request::jar($req [,$name])");
sv = ST(0);
@@ -75,11 +85,10 @@
iv = SvIVX(SvRV(obj));
req = INT2PTR(apreq_handle_t *, iv);
-
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_pkg, obj);
+ ST(0) = apreq_xs_cookie2sv(aTHX_ c, COOKIE_CLASS, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -89,7 +98,7 @@
s = apreq_jar(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
XSRETURN_UNDEF;
}
@@ -102,12 +111,12 @@
s = apreq_jar(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = cookie_pkg;
+ d.pkg = COOKIE_CLASS;
d.parent = obj;
switch (GIMME_V) {
@@ -123,7 +132,8 @@
return;
case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, jar_pkg, obj);
+ ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
+ COOKIE_CLASS, sizeof(COOKIE_CLASS)-1);
sv_2mortal(ST(0));
XSRETURN(1);
@@ -134,33 +144,50 @@
}
-static XS(apreq_xs_table_get)
+static XS(apreq_xs_table_FETCH)
{
dXSARGS;
const apr_table_t *t;
- apreq_handle_t *req;
- const char *elt_pkg = "APR::Request::Cookie";
- SV *sv, *t_obj, *r_obj;
+ const char *cookie_class;
+ SV *sv, *t_obj, *parent;
IV iv;
+ MAGIC *mg;
- if (items == 0 || items > 2 || !SvROK(ST(0)))
- Perl_croak(aTHX_ "Usage: APR::Request::Cookie::Table::get($req
[,$name])");
+ if (items != 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::FETCH($table, $key)");
sv = ST(0);
- t_obj = apreq_xs_find_obj(aTHX_ sv, "cookie");
+ t_obj = apreq_xs_find_obj(aTHX_ sv, "param");
iv = SvIVX(SvRV(t_obj));
t = INT2PTR(const apr_table_t *, iv);
- r_obj = apreq_xs_find_obj(aTHX_ t_obj, "request");
- iv = SvIVX(SvRV(r_obj));
- req = INT2PTR(apreq_handle_t *, iv);
-
- if (items == 2 && GIMME_V == G_SCALAR) {
- const char *v = apr_table_get(t, SvPV_nolen(ST(1)));
+ mg = mg_find(SvRV(t_obj), PERL_MAGIC_ext);
+ cookie_class = mg->mg_ptr;
+ parent = mg->mg_obj;
+
+
+ if (GIMME_V == G_SCALAR) {
+ IV idx;
+ const char *key, *val;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
+ key = SvPV_nolen(ST(1));
+
+ idx = SvCUR(SvRV(t_obj));
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
+
+ if (idx > 0 && idx <= arr->nelts
+ && !strcasecmp(key, te[idx-1].key))
+ val = te[idx-1].val;
+ else
+ val = apr_table_get(t, key);
- if (v != NULL) {
- ST(0) = apreq_xs_cookie2sv(aTHX_ apreq_value_to_cookie(v),
elt_pkg, r_obj);
+ if (val != NULL) {
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ ST(0) = apreq_xs_cookie2sv(aTHX_ c, cookie_class, parent);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -170,67 +197,17 @@
}
else if (GIMME_V == G_ARRAY) {
struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
-
- d.pkg = elt_pkg;
- d.parent = r_obj;
+ d.pkg = cookie_class;
+ d.parent = parent;
XSprePUSH;
PUTBACK;
- if (items == 1)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- else
- apr_table_do(apreq_xs_table_values, &d, t,
- SvPV_nolen(ST(1)), NULL);
+ apr_table_do(apreq_xs_table_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
}
else
XSRETURN(0);
}
-static XS(apreq_xs_table_FETCH)
-{
- dXSARGS;
- SV *sv, *t_obj, *r_obj;
- IV iv, idx;
- const char *key, *pkg;
- const char *val;
- const apr_table_t *t;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
- apreq_handle_t *req;
-
- if (items != 2 || !SvROK(ST(0)) || !SvOK(ST(1)))
- Perl_croak(aTHX_ "Usage: $table->FETCH($key)");
-
- sv = ST(0);
- t_obj = apreq_xs_find_obj(aTHX_ sv, "cookie");
- iv = SvIVX(SvRV(t_obj));
- t = INT2PTR(const apr_table_t *, iv);
-
- r_obj = apreq_xs_find_obj(aTHX_ t_obj, "request");
- iv = SvIVX(SvRV(r_obj));
- req = INT2PTR(apreq_handle_t *, iv);
-
- pkg = "APR::Request::Cookie";
-
- key = SvPV_nolen(ST(1));
- idx = SvCUR(SvRV(r_obj));
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (idx > 0 && idx <= arr->nelts
- && !strcasecmp(key, te[idx-1].key))
- val = te[idx-1].val;
- else
- val = apr_table_get(t, key);
-
- if (val != NULL) {
- ST(0) = apreq_xs_cookie2sv(aTHX_ apreq_value_to_cookie(val), pkg,
r_obj);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else
- XSRETURN_UNDEF;
-}
-
static XS(apreq_xs_table_NEXTKEY)
{
dXSARGS;
@@ -367,6 +344,52 @@
apreq_cookie_taint_on(obj);
else
apreq_cookie_taint_off(obj);
+ }
+
+ OUTPUT:
+ RETVAL
+
+
+APR::Request::Cookie
+make(class, pool, name, val)
+ apreq_xs_subclass_t class
+ APR::Pool pool
+ SV *name
+ SV *val
+ PREINIT:
+ STRLEN nlen, vlen;
+ const char *n, *v;
+ SV *parent = ST(1);
+
+ CODE:
+ n = SvPV(name, nlen);
+ v = SvPV(val, vlen);
+ RETVAL = apreq_cookie_make(pool, n, nlen, v, vlen);
+ if (SvTAINTED(name) || SvTAINTED(val))
+ apreq_cookie_taint_on(RETVAL);
+
+ OUTPUT:
+ RETVAL
+
+MODULE = APR::Request::Cookie PACKAGE = APR::Request::Cookie::Table
+
+SV *
+cookie_class(t, newclass=NULL)
+ APR::Request::Cookie::Table t
+ char *newclass
+ PREINIT:
+ SV *obj = apreq_xs_find_obj(aTHX_ ST(0), "table");
+ MAGIC *mg = mg_find(SvRV(obj), PERL_MAGIC_ext);
+ char *curclass = mg->mg_ptr;
+
+ CODE:
+ RETVAL = newSVpv(curclass, 0);
+ if (items == 2) {
+ if (!sv_derived_from(ST(1), curclass))
+ Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::cookie_class($table,
$class): "
+ "class %s is not derived from %s", newclass,
curclass);
+ Safefree(curclass);
+ mg->mg_ptr = savepv(newclass);
}
OUTPUT:
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=154680&r2=154681
==============================================================================
---
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
Mon Feb 21 07:30:26 2005
@@ -1,19 +1,30 @@
#include "apreq_xs_tables.h"
+#define TABLE_CLASS "APR::Request::Param::Table"
+#define PARAM_CLASS "APR::Request::Param"
+#define ERROR_CLASS "APR::Request::Error"
static APR_INLINE
-SV *apreq_xs_param2sv(pTHX_ apreq_param_t *p, const char *class, SV *handle)
+SV *apreq_xs_param2sv(pTHX_ apreq_param_t *p, const char *class, SV *parent)
{
SV *rv = sv_setref_pv(newSV(0), class, (void *)p);
- sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, Nullch, 0);
return rv;
}
static APR_INLINE
-SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV
*handle)
+apreq_param_t *apreq_xs_sv2param(pTHX_ SV *sv)
+{
+ IV iv = SvIVX(SvRV(sv));
+ return INT2PTR(apreq_param_t *, iv);
+}
+
+static APR_INLINE
+SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV
*parent,
+ const char *param_class, I32 plen)
{
SV *sv = (SV *)newHV();
SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
- sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, param_class, plen);
#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
@@ -61,13 +72,11 @@
{
dXSARGS;
apreq_handle_t *req;
- const char *error_pkg = "APR::Request::Error",
- *table_pkg = "APR::Request::Param::Table",
- *elt_pkg = "APR::Request::Param";
SV *sv, *obj;
IV iv;
- if (items == 0 || items > 2 || !SvROK(ST(0)))
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), "APR::Request"))
Perl_croak(aTHX_ "Usage: APR::Request::args($req [,$name])");
sv = ST(0);
@@ -80,7 +89,7 @@
apreq_param_t *p = apreq_args_get(req, SvPV_nolen(ST(1)));
if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, elt_pkg, obj);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, PARAM_CLASS, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -90,7 +99,7 @@
s = apreq_args(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
XSRETURN_UNDEF;
}
@@ -103,12 +112,12 @@
s = apreq_args(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = elt_pkg;
+ d.pkg = PARAM_CLASS;
d.parent = obj;
switch (GIMME_V) {
@@ -124,7 +133,8 @@
return;
case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, table_pkg, obj);
+ ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
+ PARAM_CLASS, sizeof(PARAM_CLASS)-1);
sv_2mortal(ST(0));
XSRETURN(1);
@@ -138,13 +148,11 @@
{
dXSARGS;
apreq_handle_t *req;
- const char *error_pkg = "APR::Request::Error",
- *table_pkg = "APR::Request::Param::Table",
- *elt_pkg = "APR::Request::Param";
SV *sv, *obj;
IV iv;
- if (items == 0 || items > 2 || !SvROK(ST(0)))
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), "APR::Request"))
Perl_croak(aTHX_ "Usage: APR::Request::body($req [,$name])");
sv = ST(0);
@@ -157,7 +165,7 @@
apreq_param_t *p = apreq_body_get(req, SvPV_nolen(ST(1)));
if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, elt_pkg, obj);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, PARAM_CLASS, obj);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -167,7 +175,7 @@
s = apreq_body(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
XSRETURN_UNDEF;
}
@@ -180,12 +188,12 @@
s = apreq_body(req, &t);
if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", error_pkg);
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
if (t == NULL)
XSRETURN_EMPTY;
- d.pkg = elt_pkg;
+ d.pkg = PARAM_CLASS;
d.parent = obj;
switch (GIMME_V) {
@@ -201,7 +209,8 @@
return;
case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, table_pkg, obj);
+ ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
+ PARAM_CLASS, sizeof(PARAM_CLASS)-1);
sv_2mortal(ST(0));
XSRETURN(1);
@@ -212,17 +221,18 @@
}
-static XS(apreq_xs_table_get)
+static XS(apreq_xs_table_FETCH)
{
dXSARGS;
const apr_table_t *t;
- apreq_handle_t *req;
- const char *elt_pkg = "APR::Request::Param";
- SV *sv, *t_obj, *r_obj;
+ const char *param_class;
+ SV *sv, *t_obj, *parent;
IV iv;
+ MAGIC *mg;
- if (items == 0 || items > 2 || !SvROK(ST(0)))
- Perl_croak(aTHX_ "Usage: APR::Request::body($req [,$name])");
+ if (items != 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::FETCH($table, $key)");
sv = ST(0);
@@ -230,15 +240,31 @@
iv = SvIVX(SvRV(t_obj));
t = INT2PTR(const apr_table_t *, iv);
- r_obj = apreq_xs_find_obj(aTHX_ t_obj, "request");
- iv = SvIVX(SvRV(r_obj));
- req = INT2PTR(apreq_handle_t *, iv);
-
- if (items == 2 && GIMME_V == G_SCALAR) {
- const char *v = apr_table_get(t, SvPV_nolen(ST(1)));
+ mg = mg_find(SvRV(t_obj), PERL_MAGIC_ext);
+ param_class = mg->mg_ptr;
+ parent = mg->mg_obj;
+
+
+ if (GIMME_V == G_SCALAR) {
+ IV idx;
+ const char *key, *val;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
+ key = SvPV_nolen(ST(1));
+
+ idx = SvCUR(SvRV(t_obj));
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
+
+ if (idx > 0 && idx <= arr->nelts
+ && !strcasecmp(key, te[idx-1].key))
+ val = te[idx-1].val;
+ else
+ val = apr_table_get(t, key);
- if (v != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ apreq_value_to_param(v), elt_pkg,
r_obj);
+ if (val != NULL) {
+ apreq_param_t *p = apreq_value_to_param(val);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, param_class, parent);
sv_2mortal(ST(0));
XSRETURN(1);
}
@@ -248,67 +274,17 @@
}
else if (GIMME_V == G_ARRAY) {
struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
-
- d.pkg = elt_pkg;
- d.parent = r_obj;
+ d.pkg = param_class;
+ d.parent = parent;
XSprePUSH;
PUTBACK;
- if (items == 1)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- else
- apr_table_do(apreq_xs_table_values, &d, t,
- SvPV_nolen(ST(1)), NULL);
+ apr_table_do(apreq_xs_table_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
}
else
XSRETURN(0);
}
-static XS(apreq_xs_table_FETCH)
-{
- dXSARGS;
- SV *sv, *t_obj, *r_obj;
- IV iv, idx;
- const char *key, *pkg;
- const char *val;
- const apr_table_t *t;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
- apreq_handle_t *req;
-
- if (items != 2 || !SvROK(ST(0)) || !SvOK(ST(1)))
- Perl_croak(aTHX_ "Usage: $table->FETCH($key)");
-
- sv = ST(0);
- t_obj = apreq_xs_find_obj(aTHX_ sv, "param");
- iv = SvIVX(SvRV(t_obj));
- t = INT2PTR(const apr_table_t *, iv);
-
- r_obj = apreq_xs_find_obj(aTHX_ t_obj, "request");
- iv = SvIVX(SvRV(r_obj));
- req = INT2PTR(apreq_handle_t *, iv);
-
- pkg = "APR::Request::Param";
-
- key = SvPV_nolen(ST(1));
- idx = SvCUR(SvRV(r_obj));
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (idx > 0 && idx <= arr->nelts
- && !strcasecmp(key, te[idx-1].key))
- val = te[idx-1].val;
- else
- val = apr_table_get(t, key);
-
- if (val != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ apreq_value_to_param(val), pkg, r_obj);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else
- XSRETURN_UNDEF;
-}
-
static XS(apreq_xs_table_NEXTKEY)
{
dXSARGS;
@@ -318,8 +294,8 @@
const apr_array_header_t *arr;
apr_table_entry_t *te;
- if (!SvROK(ST(0)))
- Perl_croak(aTHX_ "Usage: $table->NEXTKEY($prev)");
+ if (!SvROK(ST(0)) || !sv_derived_from(ST(0), TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::NEXTKEY($table, $key)");
sv = ST(0);
obj = apreq_xs_find_obj(aTHX_ sv, "param");
@@ -416,6 +392,52 @@
apreq_param_taint_on(obj);
else
apreq_param_taint_off(obj);
+ }
+
+ OUTPUT:
+ RETVAL
+
+APR::Request::Param
+make(class, pool, name, val)
+ apreq_xs_subclass_t class
+ APR::Pool pool
+ SV *name
+ SV *val
+ PREINIT:
+ STRLEN nlen, vlen;
+ const char *n, *v;
+ SV *parent = ST(1);
+
+ CODE:
+ n = SvPV(name, nlen);
+ v = SvPV(val, vlen);
+ RETVAL = apreq_param_make(pool, n, nlen, v, vlen);
+ if (SvTAINTED(name) || SvTAINTED(val))
+ apreq_param_taint_on(RETVAL);
+
+ OUTPUT:
+ RETVAL
+
+
+MODULE = APR::Request::Param PACKAGE = APR::Request::Param::Table
+
+SV *
+param_class(t, newclass=NULL)
+ APR::Request::Param::Table t
+ char *newclass
+ PREINIT:
+ SV *obj = apreq_xs_find_obj(aTHX_ ST(0), "table");
+ MAGIC *mg = mg_find(SvRV(obj), PERL_MAGIC_ext);
+ char *curclass = mg->mg_ptr;
+
+ CODE:
+ RETVAL = newSVpv(curclass, 0);
+ if (items == 2) {
+ if (!sv_derived_from(ST(1), curclass))
+ Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::param_class($table,
$class): "
+ "class %s is not derived from %s", newclass,
curclass);
+ Safefree(curclass);
+ mg->mg_ptr = savepv(newclass);
}
OUTPUT:
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=154680&r2=154681
==============================================================================
---
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
Mon Feb 21 07:30:26 2005
@@ -27,11 +27,13 @@
#include "ppport.h"
/* ExtUtils::XSBuilder::ParseSoure trickery... */
-typedef apreq_handle_t apreq_handle_cgi_t;
-typedef apreq_handle_t apreq_handle_apache2_t;
-typedef apr_table_t apreq_param_table_t;
-typedef apr_table_t apreq_cookie_table_t;
-typedef HV apreq_xs_error_t;
+typedef apreq_handle_t apreq_xs_handle_cgi_t;
+typedef apreq_handle_t apreq_xs_handle_apache2_t;
+typedef apr_table_t apreq_xs_param_table_t;
+typedef apr_table_t apreq_xs_cookie_table_t;
+typedef HV apreq_xs_error_t;
+typedef char* apreq_xs_subclass_t;
+
/**
* @file apreq_xs_postperl.h
@@ -301,6 +303,21 @@
apreq_strerror(s, buf, sizeof buf);
return newSVpv(buf, 0);
}
+
+
+static APR_INLINE
+const char *apreq_xs_helper_class(pTHX_ SV **SP, SV *sv, const char *method)
+{
+ PUSHMARK(SP);
+ XPUSHs(sv);
+ PUTBACK;
+ call_method(method, G_SCALAR);
+ SPAGAIN;
+ sv = POPs;
+ PUTBACK;
+ return SvPV_nolen(sv);
+}
+
/** @} */
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map?view=diff&r1=154680&r2=154681
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
Mon Feb 21 07:30:26 2005
@@ -119,23 +119,23 @@
DEFINE_parse | apreq_xs_parse |
MODULE=APR::Request::Apache2 PACKAGE=APR::Request::Apache2
-apreq_handle_apache2_t *:DEFINE_new | apreq_handle_apache2 (r) | const char
*:class, request_rec *:r
+apreq_xs_handle_apache2_t *:DEFINE_new | apreq_handle_apache2 (r) | const char
*:class, request_rec *:r
MODULE=APR::Request::CGI PACKAGE=APR::Request::CGI
-apreq_handle_cgi_t *:DEFINE_new | apreq_handle_cgi (p) | const char *:class,
apr_pool_t *:p
+apreq_xs_handle_cgi_t *:DEFINE_new | apreq_handle_cgi (p) | const char
*:class, apr_pool_t *:p
#################### APR::Request::Cookie stuff ####################
-
+# | apreq_cookie_bake(c, req) | apreq_cookie_t *:c, apreq_handle_t
*:req=apreq_xs_get_handle(aTHX_ ST(0))
MODULE=APR::Request::Cookie PACKAGE=APR::Request::Cookie PREFIX=apreq_cookie_
-apreq_cookie_bake | apreq_cookie_bake(c, req) | apreq_cookie_t *:c,
apreq_handle_t *:req=apreq_xs_get_handle(aTHX_ ST(0))
-apreq_cookie_bake2 | apreq_cookie_bake2(c, req) | apreq_cookie_t *:c,
apreq_handle_t *:req=apreq_xs_get_handle(aTHX_ ST(0))
+apreq_cookie_bake
+apreq_cookie_bake2
MODULE=APR::Request::Cookie PACKAGE=APR::Request PREFIX=APR__Request_
DEFINE_jar | apreq_xs_jar |
MODULE=APR::Request::Cookie PACKAGE=APR::Request::Cookie::Table
PREFIX=APR__Request__Cookie__Table_
-DEFINE_get | apreq_xs_table_get |
+DEFINE_get | apreq_xs_table_FETCH |
DEFINE_FETCH | apreq_xs_table_FETCH |
#DEFINE_new | apreq_xs_table_make |
DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
@@ -150,7 +150,7 @@
DEFINE_body | apreq_xs_body |
MODULE=APR::Request::Param PACKAGE=APR::Request::Param::Table
PREFIX=APR__Request__Param__Table_
-DEFINE_get | apreq_xs_table_get |
+DEFINE_get | apreq_xs_table_FETCH |
DEFINE_FETCH | apreq_xs_table_FETCH |
#DEFINE_new | apreq_xs_table_make |
DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map?view=diff&r1=154680&r2=154681
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
Mon Feb 21 07:30:26 2005
@@ -18,13 +18,15 @@
struct apr_table_t | APR::Table | T_HASHOBJ
struct apr_bucket_brigade | APR::Brigade
-const apr_table_t * | APR::Request::Table | T_HASHOBJ
-
-struct apreq_param_t | APR::Request::Param
-struct apreq_cookie_t | APR::Request::Cookie
+struct apreq_param_t | APR::Request::Param | T_APREQ_PARAM
+struct apreq_cookie_t | APR::Request::Cookie | T_APREQ_COOKIE
struct apreq_handle_t | APR::Request | T_APREQ_HANDLE | req
-struct apreq_handle_apache2_t | APR::Request::Apache2 | T_APREQ_HANDLE_APACHE2
-struct apreq_handle_cgi_t | APR::Request::CGI | T_APREQ_HANDLE
+struct apreq_xs_handle_apache2_t | APR::Request::Apache2 |
T_APREQ_HANDLE_APACHE2
+struct apreq_xs_handle_cgi_t | APR::Request::CGI | T_APREQ_HANDLE
struct apreq_xs_error_t | APR::Request::Error | T_APREQ_ERROR
+struct apreq_xs_cookie_table_t | APR::Request::Cookie::Table | T_HASHOBJ
+struct apreq_xs_param_table_t | APR::Request::Param::Table | T_HASHOBJ
+apreq_xs_subclass_t | SUBCLASS
+
