httpd-apreq-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From j...@apache.org
Subject svn commit: r154681 - in httpd/apreq/branches/multi-env-unstable/glue/perl: Makefile.PL t/response/TestAPI/cookie.pm t/response/TestAPI/param.pm xsbuilder/APR/Request/Cookie/Cookie.xs xsbuilder/APR/Request/Param/Param.xs xsbuilder/apreq_xs_postperl.h xsbuilder/maps/apreq_functions.map xsbuilder/maps/apreq_types.map
Date Mon, 21 Feb 2005 15:30:28 GMT
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
+
 



Mime
View raw message