You are viewing a plain text version of this content. The canonical link for it is here.
Posted to apreq-cvs@httpd.apache.org by jo...@apache.org on 2003/06/10 12:50:32 UTC
cvs commit: httpd-apreq-2/glue/perl/xsbuilder/maps apreq_functions.map
joes 2003/06/10 03:50:31
Modified: glue/perl Makefile.PL
glue/perl/t/response/TestApReq cookie.pm
glue/perl/xsbuilder apreq_xs_postperl.h
glue/perl/xsbuilder/Apache/Cookie Apache__Cookie.h Cookie_pm
glue/perl/xsbuilder/Apache/Request Apache__Request.h
Request_pm
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Start XS cleanup: big_input.t and cookie.t now pass on RedHat 8.0
Revision Changes Path
1.3 +5 -29 httpd-apreq-2/glue/perl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/Makefile.PL,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Makefile.PL 9 Jun 2003 04:00:45 -0000 1.2
+++ Makefile.PL 10 Jun 2003 10:50:31 -0000 1.3
@@ -12,14 +12,13 @@
use Apache::TestRun ();
use Apache::TestConfigPerl ();
use File::Find qw(finddepth);
-use Cwd;
-cwd =~ m{^(.+httpd-apreq-2)} or die "Can't find base cvs directory";
-my $base_dir = $1;
-my $src_dir = "$base_dir/src";
-my $env_dir = "$base_dir/env";
my @scripts = ();
-system "../../build/xsbuilder.pl VERSION run";
+{
+ local @ARGV = qw(VERSION run);
+ print "Building xs/ ...\n";
+ do "../../build/xsbuilder.pl";
+}
finddepth(sub {
return unless /(.*?\.pl)\.PL$/;
@@ -27,17 +26,7 @@
}, '.');
Apache::TestMM::filter_args();
-
Apache::TestMM::generate_script("t/TEST");
-#for my $script (@scripts) {
-# Apache::TestMM::generate_script($script);
-#}
-
-
-#for my $util (qw(Report Smoke Run)) {
-# my $class = "Apache::Test${util}";
-# $class->generate_script;
-#}
WriteMakefile(
NAME => 'httpd-apreq-2',
@@ -47,16 +36,3 @@
);
__END__
-$Apache::TestTrace::Level = 'debug';
-my $cfg = Apache::Test->config();
-
-$cfg->preamble(IfModule => '!mod_apreq.c',
- qq(LoadModule apreq_module "$env_dir/.libs/mod_apreq.so"\n));
-$cfg->configure_httpd;
-$cfg->configure_libmodperl;
-$cfg->configure_startup_pl;
-$cfg->save; # GRR! why doesn't this write the config file!?!?!?
-#$cfg->modules_configure_pm_tests;
-$cfg->generate_httpd_conf;
-
-__DATA__
1.2 +8 -6 httpd-apreq-2/glue/perl/t/response/TestApReq/cookie.pm
Index: cookie.pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/cookie.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- cookie.pm 9 Jun 2003 04:00:45 -0000 1.1
+++ cookie.pm 10 Jun 2003 10:50:31 -0000 1.2
@@ -1,10 +1,12 @@
package TestApReq::cookie;
use strict;
-use warnings FATAL => 'all';
+use warnings;# FATAL => 'all';
-use Apache::Test;
-use Apache::TestUtil;
+use Apache::Request ();
+use Apache::RequestIO;
+use Apache::RequestRec;
+use Apache::Connection;
use Apache::Cookie ();
use Apache::Request ();
@@ -13,10 +15,10 @@
sub handler {
my $r = shift;
my $apr = Apache::Request->new($r);
- my %cookies = Apache::Cookie->fetch;
-
- $r->send_http_header('text/plain');
+ my %cookies = Apache::Cookie->fetch($r);
+ $r->content_type('text/plain');
+ warn "apache => $cookies{apache}";
my $test = $apr->param('test');
my $key = $apr->param('key');
1.7 +160 -135 httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h
Index: apreq_xs_postperl.h
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- apreq_xs_postperl.h 9 Jun 2003 04:00:45 -0000 1.6
+++ apreq_xs_postperl.h 10 Jun 2003 10:50:31 -0000 1.7
@@ -1,122 +1,145 @@
#ifndef APREQ_XS_POSTPERL_H
#define APREQ_XS_POSTPERL_H
-#define apreq_table_t apr_table_t
-#define apreq_xs_class (SvROK(ST(0)) ? HvNAME(SvSTASH(ST(0))) : SvPV_nolen(ST(0)))
-#define apreq_xs_value_class ( call_method("value_class", G_SCALAR), \
- SvPV_nolen(ST(0)) )
-#define apreq_xs_table_class ( call_method("table_class", G_SCALAR), \
- SvPV_nolen(ST(0)) )
-
APR_INLINE
-static XS(apreq_xs_env)
+static SV *apreq_xs_find_obj(SV *in, const char *key)
{
- dXSARGS;
- char *class = NULL;
+ const char altkey[] = { '_', key[0] };
- /* map environment to package */
+ while (in && SvROK(in)) {
+ SV *sv = SvRV(in);
+ switch (SvTYPE(sv)) {
+ MAGIC *mg;
+ SV **svp;
+ case SVt_PVHV:
+ if (SvMAGICAL(sv) && (mg = mg_find(sv,PERL_MAGIC_tied))) {
+ in = mg->mg_obj;
+ break;
+ }
+ else if ((svp = hv_fetch((HV *)sv, key, 1, FALSE)) ||
+ (svp = hv_fetch((HV *)sv, altkey, 2, FALSE)))
+ {
+ in = *svp;
+ break;
+ }
+ Perl_croak(aTHX_ "attribute hash has no '%s' key!", key);
+ case SVt_PVMG:
+ if (SvOBJECT(sv) && SvIOK(sv))
+ return sv;
+ default:
+ Perl_croak(aTHX_ "panic: unsupported SV type: %d", SvTYPE(sv));
+ }
+ }
+ return NULL;
+}
- if (strcmp(apreq_env, "APACHE2") == 0)
- class = "Apache::RequestRec";
+/* conversion function templates based on modperl-2's sv2request_rec */
- /* else if ... add more conditionals here as
- additional environments become supported */
+APR_INLINE
+static void *apreq_xs_perl2c(SV* in, const char *name)
+{
+ SV *sv = apreq_xs_find_obj(in, name);
+ if (sv == NULL)
+ return NULL;
+ else
+ return (void *)SvIVX(sv);
+}
- if (class == NULL)
- XSRETURN(0);
+APR_INLINE
+static void *apreq_xs_perl2env(SV *sv, const char *name)
+{
+ MAGIC *mg;
+ sv = apreq_xs_find_obj(sv, name);
+ if (sv != NULL && (mg = mg_find(sv, PERL_MAGIC_ext)))
+ return mg->mg_ptr;
+ return NULL;
+}
- if (!SvROK(ST(0))) {
- ST(0) = newSVpv(class, 0);
- }
- else {
- MAGIC *mg;
- SV *sv = SvRV(ST(0));
-
- if (SvOBJECT(sv) && (mg = mg_find(sv, PERL_MAGIC_ext))) {
-
- ST(0) = sv_2mortal(sv_setref_pv(newSV(0),
- class, mg->mg_ptr));
- }
- else
- ST(0) = &PL_sv_undef;
- }
- XSRETURN(1);
+APR_INLINE
+static SV *apreq_xs_c2perl(pTHX_ void *obj, void *env, const char *class)
+{
+ SV *rv = sv_setref_pv(newSV(0), class, obj);
+ if (env)
+ sv_magic(SvRV(rv), Nullsv, PERL_MAGIC_ext, env, 0);
+ return rv;
}
-/* conversion function template based on modperl-2's sv2request_rec */
+APR_INLINE
+static SV *apreq_xs_table_c2perl(pTHX_ void *obj, void *env,
+ const char *class)
+{
+ SV *sv = (SV *)newHV();
+ SV *rv = sv_setref_pv(newSV(0), class, obj);
+ if (env)
+ sv_magic(SvRV(rv), Nullsv, PERL_MAGIC_ext, env, 0);
-#define APREQ_XS_DEFINE_CONVERT(type) \
-APR_INLINE \
-static apreq_##type##_t *apreq_xs_##type##_perl2c(pTHX_ SV* in) \
-{ \
- while (in && SvROK(in)) { \
- SV *sv = SvRV(in); \
- switch (SvTYPE(sv)) { \
- SV **svp; \
- case SVt_PVHV: \
- if ((svp = hv_fetch((HV *)sv, #type, 1, FALSE)) || \
- (svp = hv_fetch((HV *)sv, "_" #type, 2, FALSE))) \
- { \
- in = *svp; \
- break; \
- } \
- Perl_croak(aTHX_ "%s object has no `" \
- #type "' key!", HvNAME(SvSTASH(sv))); \
- case SVt_PVMG: \
- if (SvOBJECT(sv) && SvIOK(sv)) \
- return (apreq_##type##_t *)SvIVX(sv); \
- default: \
- Perl_croak(aTHX_ "panic: unsupported apreq_" #type \
- "_t type \%d", \
- SvTYPE(sv)); \
- } \
- } \
- return NULL; \
-} \
-APR_INLINE \
-static SV *apreq_xs_##type##_c2perl(pTHX_ apreq_##type##_t *t, \
- void *env, const char *class) \
-{ \
- SV *rv = sv_setref_pv(newSV(0), class, t); \
- sv_magic(SvRV(rv), Nullsv, PERL_MAGIC_ext, env, 0); \
- return rv; \
-} \
- \
-APR_INLINE \
-static void *apreq_xs_##type##_perl2env(SV *sv) \
-{ \
- MAGIC *mg = mg_find(SvROK(sv) ? SvRV(sv): sv, PERL_MAGIC_ext); \
- return mg ? mg->mg_ptr : NULL; \
+ sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
+ return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+}
+
+
+#define apreq_xs_2sv(t,class) apreq_xs_c2perl(aTHX_ t, env, class)
+#define apreq_xs_sv2(type,sv)((apreq_##type##_t *)apreq_xs_perl2c(sv, #type))
+#define apreq_xs_sv2env(type,sv) apreq_xs_perl2env(sv,#type)
+
+#define APREQ_XS_DEFINE_ENV(type) \
+APR_INLINE \
+static XS(apreq_xs_##type##_env) \
+{ \
+ char *class = NULL; \
+ dXSARGS; \
+ /* map environment to package */ \
+ \
+ if (strcmp(apreq_env, "APACHE2") == 0) \
+ class = "Apache::RequestRec"; \
+ \
+ /* else if ... add more conditionals here as \
+ additional environments become supported */ \
+ \
+ if (class == NULL) \
+ XSRETURN(0); \
+ \
+ if (SvROK(ST(0))) { \
+ void *env = apreq_xs_sv2env(type, ST(0)); \
+ \
+ if (env) \
+ ST(0) = sv_setref_pv(newSV(0), class, env); \
+ else \
+ ST(0) = &PL_sv_undef; \
+ } \
+ else \
+ ST(0) = newSVpv(class, 0); \
+ \
+ XSRETURN(1); \
}
/* requires type##2sv macro */
-#define APREQ_XS_DEFINE_OBJECT(type) \
+#define APREQ_XS_DEFINE_OBJECT(type,class) \
static XS(apreq_xs_##type) \
{ \
dXSARGS; \
void *env; \
apr_pool_t *pool; \
- const char *class, *data; \
+ const char *data; \
apreq_##type##_t *obj; \
\
if (items < 2 || SvROK(ST(0)) || !SvROK(ST(1))) \
Perl_croak(aTHX_ "Usage: $class->" #type "($env, $data)"); \
\
- class = SvPV_nolen(ST(0)); \
env = (void *)SvIVX(SvRV(ST(1))); \
data = (items == 3) ? SvPV_nolen(ST(2)) : NULL; \
obj = apreq_##type(env, data); \
\
- ST(0) = obj ? sv_2mortal(apreq_xs_##type##2sv(obj,class)) : \
+ ST(0) = obj ? sv_2mortal(apreq_xs_2sv(obj,class)) : \
&PL_sv_undef; \
XSRETURN(1); \
}
-/* requires definition of type##2sv macro */
+/* requires definition of apreq_xs_##type##2sv(t,class) macro */
#define APREQ_XS_DEFINE_MAKE(type) \
static XS(apreq_xs_make_##type) \
@@ -124,7 +147,7 @@
dXSARGS; \
void *env; \
apr_pool_t *pool; \
- const char *class, *key, *val; \
+ const char *key, *val, *class; \
STRLEN klen, vlen; \
apreq_##type##_t *t; \
\
@@ -138,47 +161,46 @@
val = SvPV(ST(3), vlen); \
t = apreq_make_##type(pool, key, klen, val, vlen); \
\
- ST(0) = apreq_xs_##type##2sv(t, class); \
+ ST(0) = sv_2mortal(apreq_xs_##type##2sv(t,class)); \
XSRETURN(1); \
}
-struct do_arg {
- const char *class;
+struct apreq_xs_do_arg {
void *env;
PerlInterpreter *perl;
};
+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;
+ void *env = d->env;
+ dTHXa(d->perl);
+ dSP;
+ if (key)
+ XPUSHs(sv_2mortal(newSVpv(key,0)));
+ else
+ XPUSHs(&PL_sv_undef);
+
+ PUTBACK;
+ return 1;
+}
+
/* requires definition of type##2sv macro */
+#define apreq_table_t apr_table_t
+#define apreq_xs_table_sv2table(sv) apreq_xs_sv2(table,sv)
-#define APREQ_XS_DEFINE_GET(type, subtype) \
-static int apreq_xs_##type##_table_keys(void *data, const char *key, \
- const char *val) \
-{ \
- struct do_arg *d = (struct do_arg *)data; \
- void *env = d->env; \
- const char *class = d->class; \
- dTHXa(d->perl); \
- dSP; \
- if (key) \
- XPUSHs(sv_2mortal(newSVpv(key,0))); \
- else \
- XPUSHs(&PL_sv_undef); \
- \
- PUTBACK; \
- return 1; \
-} \
+#define APREQ_XS_DEFINE_GET(type, subtype, subclass) \
static int apreq_xs_##type##_table_values(void *data, const char *key, \
- const char *val) \
+ const char *val) \
{ \
- struct do_arg *d = (struct do_arg *)data; \
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data; \
void *env = d->env; \
- const char *class = d->class; \
dTHXa(d->perl); \
dSP; \
if (val) \
XPUSHs(sv_2mortal(apreq_xs_##subtype##2sv( \
- apreq_value_to_##subtype(apreq_strtoval(val)), \
- class))); \
+ apreq_value_to_##subtype(apreq_strtoval(val)), subclass))); \
else \
XPUSHs(&PL_sv_undef); \
\
@@ -192,17 +214,15 @@
const char *key = NULL; \
\
if (items == 1 || items == 2) { \
- SV *sv = ST(0); \
- void *env = apreq_xs_##type##_perl2env(sv); \
- const char *class = apreq_xs_value_class; \
- struct do_arg d = { class, env, aTHX }; \
- apr_table_t *t = apreq_xs_##type##_sv2table(sv); \
+ apr_table_t *t = apreq_xs_##type##_sv2table(ST(0)); \
+ void *env = apreq_xs_sv2env(type, ST(0)); \
+ struct apreq_xs_do_arg d = { env, aTHX }; \
\
if (items == 2) \
key = SvPV_nolen(ST(1)); \
\
if (t == NULL) \
- Perl_croak(aTHX_ "Usage: $table->get($key)"); \
+ Perl_croak(aTHX_ "usage: $table->get($key)"); \
\
switch (GIMME_V) { \
const char *val; \
@@ -210,17 +230,21 @@
case G_ARRAY: \
XSprePUSH; \
PUTBACK; \
- apr_table_do(items == 1 ? apreq_xs_##type##_table_keys : \
- apreq_xs_##type##_table_values, &d, t, key, NULL); \
+ apr_table_do(items == 1 ? apreq_xs_table_keys : \
+ apreq_xs_##type##_table_values, &d, t, key, NULL); \
break; \
\
case G_SCALAR: \
+ if (items == 1) { \
+ ST(0) = sv_2mortal(apreq_xs_table2sv(t)); \
+ XSRETURN(1); \
+ } \
+ \
val = apr_table_get(t, key); \
if (val == NULL) \
XSRETURN_UNDEF; \
ST(0) = sv_2mortal(apreq_xs_##subtype##2sv( \
- apreq_value_to_##subtype( \
- apreq_strtoval(val)), class)); \
+ apreq_value_to_##subtype(apreq_strtoval(val)),subclass)); \
XSRETURN(1); \
\
default: \
@@ -231,25 +255,26 @@
Perl_croak(aTHX_ "Usage: $table->get($key)"); \
}
-/* requires sv2##type, type##2env & type##2##subtype macros */
+/* requires type##2env & type##2##subtype macros */
-#define APREQ_XS_DEFINE_TABLE(type, subtype) \
-static XS(apreq_xs_##type##_##subtype) \
-{ \
- dXSARGS; \
- apreq_##type##_t *obj; \
- void *env; \
- SV *sv; \
- \
- if (items != 1) \
- Perl_croak(aTHX_ "Usage: " #type "->" #subtype "()"); \
- \
- sv = ST(0); \
- obj = apreq_xs_sv2##type(sv); \
- env = apreq_xs_##type##2env(obj); \
- ST(0) = apreq_xs_table2sv(apreq_xs_##type##2##subtype(obj), \
- apreq_xs_table_class); \
- XSRETURN(1); \
+#define APREQ_XS_DEFINE_TABLE(type, subtype) \
+static XS(apreq_xs_##type##_##subtype) \
+{ \
+ dXSARGS; \
+ apreq_##type##_t *obj; \
+ apr_table_t *t; \
+ void *env; \
+ SV *sv; \
+ \
+ if (items != 1) \
+ Perl_croak(aTHX_ "Usage: " #type "->" #subtype "()"); \
+ \
+ sv = ST(0); \
+ obj = apreq_xs_sv2(type, sv); \
+ env = apreq_xs_sv2env(type, sv); \
+ t = apreq_xs_##type##2##subtype(obj); \
+ ST(0) = sv_2mortal(apreq_xs_table2sv(t)); \
+ XSRETURN(1); \
}
1.5 +19 -32 httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Apache__Cookie.h
Index: Apache__Cookie.h
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Apache__Cookie.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Apache__Cookie.h 7 Jun 2003 19:57:42 -0000 1.4
+++ Apache__Cookie.h 10 Jun 2003 10:50:31 -0000 1.5
@@ -1,38 +1,25 @@
-/* jar */
-
-APREQ_XS_DEFINE_CONVERT(jar);
-
-#define apreq_xs_sv2jar(sv) apreq_xs_jar_perl2c(aTHX_ sv)
-#define apreq_xs_jar2sv(j,class) apreq_xs_jar_c2perl(aTHX_ j,j->env,class)
-#define apreq_xs_jar_sv2table(sv) apreq_xs_sv2jar(sv)->cookies
+#define apreq_xs_jar_sv2table(sv) (apreq_xs_sv2(jar, sv)->cookies)
+#define apreq_xs_jar2cookies(j) j->cookies
#define apreq_xs_jar2env(j) j->env
-APREQ_XS_DEFINE_OBJECT(jar);
-
-/* cookie */
-
-APREQ_XS_DEFINE_CONVERT(cookie);
+#define apreq_xs_table2sv(t) apreq_xs_table_c2perl(aTHX_ t, env, \
+ "Apache::Cookie::Table")
+#define apreq_xs_cookie2sv(c,class) apreq_xs_2sv(c,class)
-#define apreq_xs_sv2cookie(sv) apreq_xs_cookie_perl2c(aTHX_ sv)
-#define apreq_xs_cookie2sv(c,class) apreq_xs_cookie_c2perl(aTHX_ c,env,class)
-#define apreq_xs_cookie_sv2env(sv) apreq_xs_cookie_perl2env(sv)
+APREQ_XS_DEFINE_ENV(cookie);
+APREQ_XS_DEFINE_ENV(jar);
-APREQ_XS_DEFINE_MAKE(cookie);
-
-APREQ_XS_DEFINE_GET(jar,cookie);
+/* jar */
-/* table */
-APREQ_XS_DEFINE_CONVERT(table);
+APREQ_XS_DEFINE_OBJECT(jar, "Apache::Cookie::Jar");
+APREQ_XS_DEFINE_TABLE(jar, cookies);
+APREQ_XS_DEFINE_GET(jar, cookie, "Apache::Cookie");
-#define apreq_xs_table2sv(t,class) apreq_xs_table_c2perl(aTHX_ t,env,class)
-#define apreq_xs_sv2table(sv) apreq_xs_table_perl2c(aTHX_ sv)
-#define apreq_xs_table_sv2table(sv) apreq_xs_sv2table(sv)
-#define apreq_xs_table_sv2env(sv) apreq_xs_table_perl2env(sv)
+/* cookie */
-#define apreq_xs_jar2cookies(j) j->cookies
-APREQ_XS_DEFINE_TABLE(jar,cookies);
+APREQ_XS_DEFINE_MAKE(cookie);
+APREQ_XS_DEFINE_GET(table, cookie, "Apache::Cookie");
-APREQ_XS_DEFINE_GET(table,cookie);
static XS(apreq_xs_cookie_as_string)
{
@@ -44,7 +31,7 @@
Perl_croak(aTHX_ "Usage: $cookie->as_string()");
sv = ST(0);
- c = apreq_xs_sv2cookie(sv);
+ c = apreq_xs_sv2(cookie,sv);
sv = NEWSV(0, apreq_serialize_cookie(NULL, 0, c));
SvCUR(sv) = apreq_serialize_cookie(SvPVX(sv), SvLEN(sv), c);
SvPOK_on(sv);
@@ -60,10 +47,10 @@
if (items == 0)
XSRETURN_UNDEF;
- c = apreq_xs_sv2cookie(ST(0));
+ c = apreq_xs_sv2(cookie,ST(0));
if (items > 1) {
- apr_pool_t *p = apreq_env_pool(apreq_xs_cookie_sv2env(ST(0)));
+ apr_pool_t *p = apreq_env_pool(apreq_xs_sv2env(cookie,ST(0)));
const char *s = SvPV_nolen(ST(1));
apreq_cookie_expires(p, c, s);
}
@@ -88,8 +75,8 @@
if (items == 0)
XSRETURN_UNDEF;
- c = apreq_value_to_cookie(apreq_xs_sv2cookie(ST(0)));
- p = apreq_env_pool(apreq_xs_cookie_sv2env(ST(0)));
+ c = apreq_value_to_cookie(apreq_xs_sv2(cookie,ST(0)));
+ p = apreq_env_pool(apreq_xs_sv2env(cookie,ST(0)));
for (j = 1; j + 1 < items; j += 2) {
status = apreq_cookie_attr(p, c, SvPV_nolen(ST(j)),
1.4 +7 -9 httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Cookie_pm
Index: Cookie_pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Cookie_pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Cookie_pm 9 Jun 2003 04:00:45 -0000 1.3
+++ Cookie_pm 10 Jun 2003 10:50:31 -0000 1.4
@@ -1,5 +1,5 @@
use strict;
-use warnings FATAL => 'all';
+#use warnings FATAL => 'all';
use Apache2;
use APR;
use APR::Table;
@@ -7,18 +7,14 @@
package Apache::Cookie::Jar;
push our(@ISA), __PACKAGE__ -> env;
-sub value_class { 'Apache::Cookie' }
-sub table_class { 'Apache::Cookie::Table' }
-
package Apache::Cookie::Table;
use base 'APR::Table';
-sub value_class { 'Apache::Cookie' }
package Apache::Cookie;
push our(@ISA), __PACKAGE__ -> env;
-
-use overload '"' => sub {${$_[0]}};
+use Devel::Peek;
+#use overload '"' => sub {${$_[0]}};
sub status { ${$_[0]} + 0 }
@@ -36,7 +32,8 @@
sub fetch {
my $self = shift;
my $jar = $self->jar(@_);
- return wantarray ? map +($_->name, $_), $jar->get() : $jar;
+ Dump($jar->cookies);
+ return wantarray ? %{$jar->cookies} : $jar->cookies;
}
sub freeze {
@@ -56,5 +53,6 @@
sub thaw {
my $self = shift;
- return $self->name, map url_decode($_), split /&/, $self;
+ return map url_decode($_), split /&/, $self;
}
+
1.6 +35 -68 httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Apache__Request.h
Index: Apache__Request.h
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Apache__Request.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Apache__Request.h 9 Jun 2003 04:00:45 -0000 1.5
+++ Apache__Request.h 10 Jun 2003 10:50:31 -0000 1.6
@@ -1,86 +1,42 @@
-APREQ_XS_DEFINE_CONVERT(request);
-
-#define apreq_xs_sv2request(sv) apreq_xs_request_perl2c(aTHX_ sv)
-#define apreq_xs_request2sv(r,class) apreq_xs_request_c2perl(aTHX_ r, r->env, class)
-#define apreq_xs_request_sv2env(sv) apreq_xs_sv2request(sv)->env
#define apreq_xs_request2env(r) r->env
+#define apreq_xs_request2args(r) r->args
+#define apreq_xs_request2body(r) r->body
+#define apreq_xs_request2params(r) apreq_params(apreq_env_pool(env),r)
+#define apreq_xs_param2rv(ptr) sv_setref_pv(newSV(0), "Apache::Upload", ptr)
+#define apreq_xs_rv2param(sv) ((apreq_param_t *)SvIVX(SvRV(sv)))
+#define apreq_xs_table2sv(t) apreq_xs_2sv(t,"Apache::Request::Table")
-APREQ_XS_DEFINE_OBJECT(request);
-
-
-APR_INLINE
-static SV *apreq_xs_param2sv(const apreq_param_t *param,
- const char *class)
+APR_INLINE static SV *apreq_xs_param2sv(const apreq_param_t *param,
+ const char *class)
{
SV *sv = newSVpvn(param->v.data, param->v.size);
if (param->charset == UTF_8)
SvUTF8_on(sv);
- SvTAINT(sv);
return sv;
}
-/* there is no sv2param, since param isn't an object */
+APREQ_XS_DEFINE_ENV(request);
+APREQ_XS_DEFINE_OBJECT(request, "Apache::Request");
APREQ_XS_DEFINE_MAKE(param);
-APREQ_XS_DEFINE_CONVERT(table);
+APREQ_XS_DEFINE_TABLE(request, args);
+APREQ_XS_DEFINE_TABLE(request, body);
+APREQ_XS_DEFINE_TABLE(request, params);
-#define apreq_xs_table2sv(t,class) apreq_xs_table_c2perl(aTHX_ t,env,class)
-#define apreq_xs_sv2table(sv) apreq_xs_table_perl2c(aTHX_ sv)
-#define apreq_xs_table_sv2table(sv) apreq_xs_sv2table(sv)
+APREQ_XS_DEFINE_GET(table, param, NULL);
-#define apreq_xs_request2args(r) r->args
-#define apreq_xs_request2body(r) r->body
-#define apreq_xs_request2params(r) apreq_params(apreq_env_pool(env),r)
-APREQ_XS_DEFINE_TABLE(request,args);
-APREQ_XS_DEFINE_TABLE(request,body);
-APREQ_XS_DEFINE_TABLE(request,params);
-APREQ_XS_DEFINE_GET(table,param);
-
-
-/* might be used for making upload objects */
-
-APR_INLINE
-static SV *apreq_xs_param2rv(const apreq_param_t *param,
- const char *class)
-{
- SV *rv = sv_setref_pv(newSV(0), class, (void *)param);
- SvTAINT(SvRV(rv));
- return rv;
-}
-
-#define apreq_xs_rv2param(sv) ((apreq_param_t *)SvIVX(SvRV(sv)))
-#define apreq_xs_param_table_do (items==1 ? apreq_xs_param_table_keys : \
- apreq_xs_param_table_values)
-
-static int apreq_xs_param_table_keys(void *data, const char *key,
- const char *val)
-{
- struct do_arg *d = (struct do_arg *)data;
- void *env = d->env;
- const char *class = d->class;
- dTHXa(d->perl);
- dSP;
- if (val)
- XPUSHs(sv_2mortal(newSVpv(key, 0)));
- else
- XPUSHs(&PL_sv_undef);
-
- PUTBACK;
- return 1;
-}
static int apreq_xs_param_table_values(void *data, const char *key,
const char *val)
{
- struct do_arg *d = (struct do_arg *)data;
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
void *env = d->env;
- const char *class = d->class;
dTHXa(d->perl);
dSP;
if (val)
- XPUSHs(sv_2mortal(apreq_xs_param2sv(
- apreq_value_to_param(apreq_strtoval(val)),class)));
+ XPUSHs(sv_2mortal(apreq_xs_param2sv(apreq_value_to_param(
+ apreq_strtoval(val)),NULL)));
else
XPUSHs(&PL_sv_undef);
@@ -89,6 +45,14 @@
return 1;
}
+
+#ifdef apreq_xs_table_do
+#undef apreq_xs_table_do
+#endif
+
+#define apreq_xs_table_do (items == 1 ? apreq_xs_table_keys \
+ : apreq_xs_param_table_values)
+
static XS(apreq_xs_param)
{
dXSARGS;
@@ -96,10 +60,9 @@
if (items == 1 || items == 2) {
SV *sv = ST(0);
- apreq_request_t *req = apreq_xs_sv2request(sv);
+ apreq_request_t *req = apreq_xs_sv2(request,sv);
void *env = req->env;
- const char *class = NULL; /* params aren't objects */
- struct do_arg d = { class, env, aTHX };
+ struct apreq_xs_do_arg d = { env, aTHX };
if (items == 2)
key = SvPV_nolen(ST(1));
@@ -113,18 +76,22 @@
case G_ARRAY:
XSprePUSH;
PUTBACK;
- apr_table_do(apreq_xs_param_table_do, &d, req->args, key, NULL);
+ apr_table_do(apreq_xs_table_do, &d, req->args, key, NULL);
if (req->body)
- apr_table_do(apreq_xs_param_table_do,&d,req->body,key,NULL);
+ apr_table_do(apreq_xs_table_do,&d,req->body,key,NULL);
break;
case G_SCALAR:
+ if (items == 1) {
+ ST(0) = sv_2mortal(apreq_xs_table2sv(
+ apreq_params(apreq_env_pool(env), req)));
+ XSRETURN(1);
+ }
param = apreq_param(req, key);
if (param == NULL)
XSRETURN_UNDEF;
-
- ST(0) = sv_2mortal(apreq_xs_param2sv(param, class));
+ ST(0) = sv_2mortal(apreq_xs_param2sv(param,NULL));
XSRETURN(1);
default:
1.5 +1 -3 httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pm
Index: Request_pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Request_pm 9 Jun 2003 04:00:45 -0000 1.4
+++ Request_pm 10 Jun 2003 10:50:31 -0000 1.5
@@ -6,12 +6,10 @@
package Apache::Request::Table;
use base 'APR::Table';
-sub value_class { undef }
package Apache::Request;
push our(@ISA), __PACKAGE__ -> env;
-sub value_class { undef }
-sub table_class { 'Apache::Request::Table' }
+
sub config {}
sub new {
my $class = shift;
1.5 +19 -19 httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map
Index: apreq_functions.map
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- apreq_functions.map 9 Jun 2003 04:00:45 -0000 1.4
+++ apreq_functions.map 10 Jun 2003 10:50:31 -0000 1.5
@@ -4,41 +4,41 @@
apreq_request | apreq_xs_request | const char *:class, void *:env, const char *:qs=NULL
apreq_parse_request
apreq_params
- apreq_param | apreq_xs_param | ...
+ apreq_param | apreq_xs_param |
MODULE=Apache::Request PACKAGE=Apache::Request
- DEFINE_env | apreq_xs_env | ...
+ DEFINE_env | apreq_xs_request_env |
-MODULE=Apache::Request PACKAGE=Apache::Request::Table
- DEFINE_get | apreq_xs_table_table_get | ...
- DEFINE_FETCH | apreq_xs_table_table_get | ...
- DEFINE_env | apreq_xs_env | ...
+MODULE=Apache::Request PACKAGE=Apache::Request::Table PREFIX=Apache__Request__Table_
+ DEFINE_get | apreq_xs_table_table_get |
+ DEFINE_FETCH | apreq_xs_table_table_get |
MODULE=Apache::Cookie PACKAGE=Apache::Cookie
- SV *:DEFINE_jar | apreq_xs_jar | const char *:class, void *:env, const char *:hdr=NULL
- SV *:DEFINE_as_string | apreq_xs_cookie_as_string | SV *:c
- SV *:DEFINE_make | apreq_xs_make_cookie(aTHX_ class, env, name, val) | const char *:class, void *:env, SV *:name, SV *:val
- DEFINE_expires | apreq_xs_cookie_expires |
- DEFINE_set_attr | apreq_xs_cookie_set_attr |
- DEFINE_env | apreq_xs_env |
- apr_status_t:DEFINE_bake | apreq_cookie_bake (apreq_xs_sv2cookie(c), apreq_xs_cookie_perl2env(c)) | SV *:c
- apr_status_t:DEFINE_bake2| apreq_cookie_bake2(apreq_xs_sv2cookie(c), apreq_xs_cookie_perl2env(c)) | SV *:c
+ DEFINE_jar | apreq_xs_jar |
+ DEFINE_as_string | apreq_xs_cookie_as_string |
+ DEFINE_make | apreq_xs_make_cookie |
+ DEFINE_expires | apreq_xs_cookie_expires |
+ DEFINE_set_attr | apreq_xs_cookie_set_attr |
+ DEFINE_env | apreq_xs_cookie_env |
+ const char *:DEFINE_name | apreq_cookie_name(c) | apreq_cookie_t *:c
+ const char *:DEFINE_value| apreq_cookie_value(c) | apreq_cookie_t *:c
+ apr_status_t:DEFINE_bake | apreq_cookie_bake (apreq_xs_sv2(cookie,c), apreq_xs_sv2env(cookie,c)) | SV *:c
+ apr_status_t:DEFINE_bake2| apreq_cookie_bake2(apreq_xs_sv2(cookie,c), apreq_xs_sv2env(cookie,c)) | SV *:c
-MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Jar
+MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Jar PREFIX=Apache__Cookie__Jar_
+ DEFINE_env | apreq_xs_jar_env |
DEFINE_get | apreq_xs_jar_table_get |
DEFINE_cookies | apreq_xs_jar_cookies |
- DEFINE_env | apreq_xs_env |
-MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Table
+MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Table PREFIX=Apache__Cookie__Table_
DEFINE_get | apreq_xs_table_table_get |
DEFINE_FETCH | apreq_xs_table_table_get |
- DEFINE_env | apreq_xs_env |
MODULE=Apache::Request PACKAGE=Apache::Request::Util PREFIX=apreq_
apreq_log
# apreq_join
- apreq_index
+#apreq_index
apreq_encode
# apreq_decode
# apreq_expires