joes 2003/05/31 00:01:51
Modified: glue/perl/xsbuilder apreq_xs_postperl.h
glue/perl/xsbuilder/Apache/Cookie Apache__Cookie.h
glue/perl/xsbuilder/Apache/Request Apache__Request.h
Log:
Choose better names for xs converter macros and eliminate the recursive
hv_find function.
Revision Changes Path
1.4 +74 -105 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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apreq_xs_postperl.h 31 May 2003 05:39:51 -0000 1.3
+++ apreq_xs_postperl.h 31 May 2003 07:01:50 -0000 1.4
@@ -4,114 +4,83 @@
/* conversion function template based on modperl-2's sv2request_rec */
-#define APREQ_XS_DEFINE_SV2(type, class) \
-static \
-SV *apreq_xs_hv_find_##type(pTHX_ SV *in) \
-{ \
- static char *keys[] = { #type, "_" #type, NULL }; \
- HV *hv = (HV *)SvRV(in); \
- SV *sv = Nullsv; \
- int i; \
- \
- for (i=0; keys[i]; i++) { \
- int klen = i + 1; /* assumes keys[] will never change */ \
- SV **svp; \
- \
- if ((svp = hv_fetch(hv, keys[i], klen, FALSE)) && (sv = *svp)) { \
- if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVHV)) { \
- /* dig deeper */ \
- return apreq_xs_hv_find_##type(aTHX_ sv); \
- } \
- break; \
- } \
- } \
- \
- if (!sv) { \
- Perl_croak(aTHX_ \
- "`%s' object hash no `" #type "' key!", \
- HvNAME(SvSTASH(SvRV(in)))); \
- } \
- \
- return SvROK(sv) ? SvRV(sv) : sv; \
-} \
-APR_INLINE \
-static \
-apreq_##type##_t *apreq_xs_sv2##type(pTHX_ SV* in) \
-{ \
- SV *sv = Nullsv; \
- MAGIC *mg; \
- \
- if (SvROK(in)) { \
- SV *rv = (SV*)SvRV(in); \
- switch (SvTYPE(rv)) { \
- case SVt_PVHV: \
- rv = apreq_xs_hv_find_##type(aTHX_ in); \
- if (SvTYPE(rv) != SVt_PVIV) \
- break; \
- case SVt_PVIV: \
- return (apreq_##type##_t *)SvIVX(rv); \
- default: \
- Perl_croak(aTHX_ "panic: unsupported apreq_" #type \
- "_t type \%d", \
- SvTYPE(rv)); \
- } \
- } \
- return NULL; \
-} \
-APR_INLINE \
-static \
-SV *apreq_xs_##type##2sv(apreq_##type##_t *t) \
-{ \
- SV *sv = newSViv(0); \
- SvUPGRADE(sv, SVt_PVIV); \
- SvGROW(sv, sizeof *t); \
- SvIVX(sv) = (IV)t; \
- SvIOK_on(sv); \
- SvPOK_on(sv); \
- sv_magic(sv, Nullsv, PERL_MAGIC_ext, (char *)t->env, 0); \
- \
- /* initialize sv as an object */ \
- SvSTASH(sv) = gv_stashpv(class, TRUE); \
- SvOBJECT_on(sv); \
- return newRV_noinc(sv); \
+#define APREQ_XS_DEFINE_SV_CONVERT(type, class) \
+APR_INLINE static apreq_##type##_t *apreq_xs_sv2##type(pTHX_ SV* in) \
+{ \
+ while (in && SvROK(in) & sv_derived_from(in, class)) { \
+ SV *sv = SvRV(sv); \
+ 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_ class "- derived `%s' object has no `" \
+ #type "' key!", HvNAME(SvSTASH(sv))); \
+ case SVt_PVMG: \
+ 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##2sv(apreq_##type##_t *t) \
+{ \
+ SV *sv = newSViv(0); \
+ SvUPGRADE(sv, SVt_PVIV); \
+ SvGROW(sv, sizeof *t); \
+ SvIVX(sv) = (IV)t; \
+ SvIOK_on(sv); \
+ SvPOK_on(sv); \
+ sv_magic(sv, Nullsv, PERL_MAGIC_ext, (char *)t->env, 0); \
+ \
+ /* initialize sv as an object */ \
+ SvSTASH(sv) = gv_stashpv(class, TRUE); \
+ SvOBJECT_on(sv); \
+ return newRV_noinc(sv); \
}
-#define APREQ_XS_DEFINE_TIEDSV(type, class) \
-static int apreq_xs_##type##_free(pTHX_ SV* sv, MAGIC *mg) \
-{ \
- /* need to prevent perl from freeing the apreq value */ \
- SvPVX(sv) = NULL; \
- SvCUR_set(sv,0); \
- SvPOK_off(sv); \
- return 0; \
-} \
-const static MGVTBL apreq_xs_##type##_magic = { 0, 0, 0, 0, \
- apreq_xs_##type##_free }; \
- \
-APR_INLINE \
-static SV *apreq_xs_##type##2sv(apreq_##type##_t *t) \
-{ \
- SV *sv = newSV(0); \
- SvUPGRADE(sv, SVt_PV); \
- SvPVX(sv) = t->v.data; \
- SvCUR_set(sv, t->v.size); \
- \
- sv_magicext(sv, Nullsv, PERL_MAGIC_tiedscalar, \
- (MGVTBL *)&apreq_xs_##type##_magic, (char *)t, 0); \
- \
- /* initialize sv as an object, so "tied" will return object ref */ \
- SvSTASH(sv) = gv_stashpv(class, TRUE); \
- SvOBJECT_on(sv); \
- \
- SvREADONLY_on(sv); \
- SvTAINT(sv); \
- return sv; \
-} \
-APR_INLINE \
-static apreq_##type##_t *apreq_xs_sv2##type(pTHX_ SV *sv) \
-{ \
- return apreq_value_to_##type(apreq_strtoval(SvPVX(sv))); \
+#define APREQ_XS_DEFINE_SV_TIE(type, class) \
+static int apreq_xs_##type##_free(pTHX_ SV* sv, MAGIC *mg) \
+{ \
+ /* need to prevent perl from freeing the apreq value */ \
+ SvPVX(sv) = NULL; \
+ SvCUR_set(sv,0); \
+ SvPOK_off(sv); \
+ return 0; \
+} \
+const static MGVTBL apreq_xs_##type##_magic = {0, 0, 0, 0, \
+ apreq_xs_##type##_free };\
+ \
+APR_INLINE static SV *apreq_xs_##type##2sv(apreq_##type##_t *t) \
+{ \
+ SV *sv = newSV(0); \
+ SvUPGRADE(sv, SVt_PV); \
+ SvPVX(sv) = t->v.data; \
+ SvCUR_set(sv, t->v.size); \
+ \
+ sv_magicext(sv, Nullsv, PERL_MAGIC_tiedscalar, \
+ (MGVTBL *)&apreq_xs_##type##_magic, (char *)t, 0); \
+ \
+ /* initialize sv as object, so "tied" will return object ref */ \
+ SvSTASH(sv) = gv_stashpv(class, TRUE); \
+ SvOBJECT_on(sv); \
+ \
+ SvREADONLY_on(sv); \
+ SvTAINT(sv); \
+ return sv; \
+} \
+APR_INLINE \
+static apreq_##type##_t *apreq_xs_sv2##type(pTHX_ SV *sv) \
+{ \
+ return apreq_value_to_##type(apreq_strtoval(SvPVX(sv))); \
}
#endif /* APREQ_XS_POSTPERL_H */
1.3 +2 -2
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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__Cookie.h 31 May 2003 05:39:51 -0000 1.2
+++ Apache__Cookie.h 31 May 2003 07:01:50 -0000 1.3
@@ -1,2 +1,2 @@
-APREQ_XS_DEFINE_SV2(jar, "Apache::Cookie::Jar");
-APREQ_XS_DEFINE_TIEDSV(cookie, "Apache::Cookie");
+APREQ_XS_DEFINE_SV_CONVERT(jar, "Apache::Cookie::Jar");
+APREQ_XS_DEFINE_SV_TIE(cookie, "Apache::Cookie");
1.3 +2 -2
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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__Request.h 31 May 2003 05:39:51 -0000 1.2
+++ Apache__Request.h 31 May 2003 07:01:51 -0000 1.3
@@ -1,2 +1,2 @@
-APREQ_XS_DEFINE_SV2(request, "Apache::Request");
-APREQ_XS_DEFINE_TIEDSV(param, "Apache::Request::Param");
+APREQ_XS_DEFINE_SV_CONVERT(request, "Apache::Request");
+APREQ_XS_DEFINE_SV_TIE(param, "Apache::Request::Param");
