Author: joes
Date: Tue Feb 15 13:45:14 2005
New Revision: 153963
URL: http://svn.apache.org/viewcvs?view=rev&rev=153963
Log:
Add $req->args, $req->body, $req->jar to APR::Request. Following
the mp2 paradigm, these methods are provided by APR::Request::Param
(for args & body) and APR::Request::Cookie (for jar).
Added:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
Removed:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.pm
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL
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/apreq_xs_tables.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=153962&r2=153963
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL Tue Feb 15
13:45:14 2005
@@ -355,7 +355,7 @@
if (my $newxs = $self->{newXS}->{$module}) {
for my $xs (@$newxs) {
print $fh qq{ cv = newXS("$xs->[0]", $xs->[1], __FILE__);\n};
- print $fh qq{ GvSHARED_on(CvGV(cv));\n} if
ExtUtils::XSBuilder::WrapXS::XSGvSHARED();
+ print $fh qq{ GvSHARED_on(CvGV(cv));\n} if
ExtUtils::XSBuilder::WrapXS::GvSHARED();
}
}
@@ -404,24 +404,6 @@
push [EMAIL PROTECTED], 'DynaLoader' ;
\$VERSION = '$version';
bootstrap $module \$VERSION ;
-EOF
-
- $text .= <<'EOF';
-
-if ($ENV{MOD_PERL}) {
- require mod_perl;
- my $env = __PACKAGE__->env || '';
- if ($mod_perl::VERSION > 1.99) {
- die __PACKAGE__ . ": httpd must load mod_apreq.so first"
- if $env ne "Apache::RequestRec";
- }
- else {
- die "Unsupported mod_perl version number: $modperl::VERSION";
- }
-}
-EOF
-
- $text .= <<"EOF";
$code
Added:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pm?view=auto&rev=153963
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pm
(added)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pm
Tue Feb 15 13:45:14 2005
@@ -0,0 +1 @@
+use APR::Request;
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=153962&r2=153963
==============================================================================
---
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 15 13:45:14 2005
@@ -1,3 +1,97 @@
+#include "apreq_xs_tables.h"
+
+static APR_INLINE
+SV *apreq_xs_cookie2sv(pTHX_ apreq_cookie_t *c, const char *class, SV *handle)
+{
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)c);
+ sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ return rv;
+}
+
+static APR_INLINE
+SV *apreq_xs_jar2sv(pTHX_ const apr_table_t *t, const char *class, SV *handle)
+{
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
+ sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+ return rv;
+}
+
+static int apreq_xs_jar_values(void *data, const char *key, const char *val)
+{
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+ dSP;
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ SV *sv = apreq_xs_cookie2sv(aTHX_ c, d->pkg, d->parent);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+static XS(apreq_xs_jar)
+{
+ 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)))
+ Perl_croak(aTHX_ "Usage: APR::Request::jar($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_find_obj(aTHX_ sv, "r");
+ iv = SvIVX(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);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_jar(req, &t);
+ if (s != APR_SUCCESS && !sv_derived_from(sv, error_pkg))
+ APREQ_XS_THROW_ERROR("r", s, "APR::Request::jar", error_pkg);
+
+ d.pkg = cookie_pkg;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ XSprePUSH;
+ PUTBACK;
+ if (items == 1)
+ apr_table_do(apreq_xs_table_keys, &d, t, NULL);
+ else
+ apr_table_do(apreq_xs_jar_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_jar2sv(aTHX_ t, jar_pkg, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
static XS(XS_APR__Request__Cookie_nil)
{
dXSARGS;
Added:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm?view=auto&rev=153963
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
(added)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
Tue Feb 15 13:45:14 2005
@@ -0,0 +1 @@
+use APR::Request;
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=153962&r2=153963
==============================================================================
---
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 15 13:45:14 2005
@@ -1,3 +1,175 @@
+#include "apreq_xs_tables.h"
+
+static APR_INLINE
+SV *apreq_xs_param2sv(pTHX_ apreq_param_t *p, const char *class, SV *handle)
+{
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)p);
+ sv_magic(SvRV(rv), handle, 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)
+{
+ SV *sv = (SV *)newHV();
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
+ sv_magic(SvRV(rv), handle, PERL_MAGIC_ext, Nullch, 0);
+
+#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
+
+ sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
+ SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_table_magic;
+ SvMAGIC(sv)->mg_flags |= MGf_COPY;
+
+#endif
+
+ sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
+ SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
+
+ return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+}
+
+static int apreq_xs_table_values(void *data, const char *key, const char *val)
+{
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+ dSP;
+ apreq_param_t *p = apreq_value_to_param(val);
+ SV *sv = apreq_xs_param2sv(aTHX_ p, d->pkg, d->parent);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+static XS(apreq_xs_args)
+{
+ 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)))
+ Perl_croak(aTHX_ "Usage: APR::Request::args($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_find_obj(aTHX_ sv, "r");
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_param_t *c = apreq_args_get(req, SvPV_nolen(ST(1)));
+ if (c != NULL) {
+ ST(0) = apreq_xs_param2sv(aTHX_ c, elt_pkg, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_args(req, &t);
+
+ if (s != APR_SUCCESS && !sv_derived_from(sv, error_pkg))
+ APREQ_XS_THROW_ERROR("r", s, "APR::Request::args", error_pkg);
+
+ d.pkg = elt_pkg;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ 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);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_table2sv(aTHX_ t, table_pkg, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
+static XS(apreq_xs_body)
+{
+ 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)))
+ Perl_croak(aTHX_ "Usage: APR::Request::body($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_find_obj(aTHX_ sv, "r");
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_param_t *c = apreq_body_get(req, SvPV_nolen(ST(1)));
+ if (c != NULL) {
+ ST(0) = apreq_xs_param2sv(aTHX_ c, elt_pkg, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_body(req, &t);
+
+ if (s != APR_SUCCESS && !sv_derived_from(sv, error_pkg))
+ APREQ_XS_THROW_ERROR("r", s, "APR::Request::body", error_pkg);
+
+ d.pkg = elt_pkg;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ 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);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_table2sv(aTHX_ t, table_pkg, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
static XS(XS_APR__Request__Param_nil)
{
dXSARGS;
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=153962&r2=153963
==============================================================================
---
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 15 13:45:14 2005
@@ -29,6 +29,8 @@
/* 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;
/**
* @file apreq_xs_postperl.h
@@ -106,6 +108,14 @@
Perl_croak(aTHX_ "Can't find magic environment");
return NULL; /* not reached */
+}
+
+APR_INLINE
+static apreq_handle_t *apreq_xs_get_handle(pTHX_ SV *sv)
+{
+ MAGIC *mg = mg_find(sv, PERL_MAGIC_ext);
+ IV iv = SvIVX(mg->mg_obj);
+ return INT2PTR(apreq_handle_t *,iv);
}
/**
Modified:
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_tables.h
URL:
http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_tables.h?view=diff&r1=153962&r2=153963
==============================================================================
---
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_tables.h
(original)
+++
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_tables.h
Tue Feb 15 13:45:14 2005
@@ -89,10 +89,10 @@
}
-#define apreq_xs_sv2table(sv) ((apr_table_t *) SvIVX(SvRV(sv)))
-#define apreq_xs_table2sv(t,class,parent,name,nlen,tainted) \
- apreq_xs_table_c2perl(aTHX_ t, name, nlen, class, parent, tainted)
-
+/*#define apreq_xs_sv2table(sv) ((apr_table_t *) SvIVX(SvRV(sv)))
+ *#define apreq_xs_table2sv(t,class,parent,name,nlen,tainted) \
+ * apreq_xs_table_c2perl(aTHX_ t, name, nlen, class, parent, tainted)
+ */
#define APREQ_XS_DEFINE_TABLE_MAKE(attr,pkg, plen) \
static XS(apreq_xs_table_##attr##_make) \
@@ -163,18 +163,11 @@
}
-/* TABLE_GET */
-struct apreq_xs_table_key_magic {
- SV *obj;
- const char *val;
-};
-
struct apreq_xs_do_arg {
- void *env;
const char *pkg;
- SV *parent, *sub;
- unsigned tainted;
+ SV *parent,
+ *sub;
PerlInterpreter *perl;
};
@@ -186,8 +179,6 @@
dSP;
SV *sv = newSVpv(key,0);
- if (d->tainted)
- SvTAINTED_on(sv);
XPUSHs(sv_2mortal(sv));
PUTBACK;
return 1;
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=153962&r2=153963
==============================================================================
---
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
Tue Feb 15 13:45:14 2005
@@ -106,10 +106,8 @@
#################### APR::Request stuff ####################
MODULE=APR::Request PACKAGE=APR::Request PREFIX=apreq_
-apreq_jar_get
-apreq_body_get
apreq_args_get
-
+apreq_jar_get
#DEFINE_jar | apreq_xs_jar |
#DEFINE_args | apreq_xs_args |
#DEFINE_body | apreq_xs_body |
@@ -121,8 +119,23 @@
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
+
+#################### APR::Request::Cookie stuff ####################
+
MODULE=APR::Request::Cookie PACKAGE=APR::Request::Cookie PREFIX=apreq_cookie_
apreq_cookie_name
+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))
+
+MODULE=APR::Request::Cookie PACKAGE=APR::Request PREFIX=APR__Request_
+DEFINE_jar | apreq_xs_jar |
+
+
+#################### APR::Request::Param stuff ####################
MODULE=APR::Request::Param PACKAGE=APR::Request::Param PREFIX=apreq_param_
apreq_param_name
+
+MODULE=APR::Request::Param PACKAGE=APR::Request PREFIX=APR__Request_
+DEFINE_args | apreq_xs_args |
+DEFINE_body | apreq_xs_body |
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=153962&r2=153963
==============================================================================
---
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
Tue Feb 15 13:45:14 2005
@@ -19,7 +19,6 @@
struct apr_bucket_brigade | APR::Brigade
const apr_table_t * | APR::Request::Table | T_HASHOBJ
-#const struct apr_table_t | APR::Request::Table | T_HASHOBJ
struct apreq_param_t | APR::Request::Param
struct apreq_cookie_t | APR::Request::Cookie
