This weekend I finally got around to implementing multivalued
key iterators in apreq2. Here is a backport of the each() code
to APR::Table, with apr-ext/table.t tests included. Rather
than lauching into a longwined explanation of the hows and
whys of this patch (see
http://marc.theaimsgroup.com/?t=105478383300002&r=1&w=2
for the priors), please look over those new apr-ext/table.t
tests to see what behavior this patch provides.
Thanks in advance for looking this over- I'll be happy to
explain it in more detail if anyone is interested.
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.82
diff -u -r1.82 apr_functions.map
--- xs/maps/apr_functions.map 9 Jun 2004 14:46:22 -0000 1.82
+++ xs/maps/apr_functions.map 12 Jul 2004 18:54:26 -0000
@@ -253,7 +253,7 @@
-apr_table_setn
apr_table_unset
-apr_table_vdo
- const char *:DEFINE_FETCH | | apr_table_t *:t, const char *:key
+ const char *:DEFINE_FETCH | MPXS_apr_table_get |
void:DEFINE_STORE | | apr_table_t *:t, const char *:key, const char *:value
void:DEFINE_DELETE | | apr_table_t *:t, const char *:key
void:DEFINE_CLEAR | | apr_table_t *:t
Index: t/apr-ext/table.t
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/apr-ext/table.t,v
retrieving revision 1.1
diff -u -r1.1 table.t
--- t/apr-ext/table.t 16 Jun 2004 03:55:48 -0000 1.1
+++ t/apr-ext/table.t 12 Jul 2004 18:54:24 -0000
@@ -1,15 +1,32 @@
use Apache::Test;
-
+use Apache::TestUtil;
use blib;
use Apache2;
-plan tests => 1;
+plan tests => 13;
require APR;
require APR::Table;
require APR::Pool;
+use APR;
+use APR::Table;
+use APR::Pool;
my $p = APR::Pool->new;
my $table = APR::Table::make($p, 2);
ok ref $table eq 'APR::Table';
+
+$table->add("first" => 1);
+$table->add("second" => 2);
+$table->add("first" => 3);
+
+my $i = 0;
+while (($a,$b) = each %$table) {
+ my $key = ("first", "second")[$i % 2];
+ my $val = ++$i;
+ ok t_cmp $a, $key, "table each: key test";
+ ok t_cmp $b, $val, "table each: value test";
+ ok t_cmp $table->get($a), $val, "table each: get test";
+ ok t_cmp tied(%$table)->get($a), $val, "table each: tied get test";
+}
Index: src/modules/perl/modperl_common_util.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_common_util.h,v
retrieving revision 1.2
diff -u -r1.2 modperl_common_util.h
--- src/modules/perl/modperl_common_util.h 22 Jun 2004 22:34:10 -0000 1.2
+++ src/modules/perl/modperl_common_util.h 12 Jul 2004 18:54:23 -0000
@@ -75,6 +75,9 @@
SV *tsv, void *p);
/* tied %hash */
+MP_INLINE SV *modperl_hash_tied_object_rv(pTHX_
+ const char *classname,
+ SV *tsv);
MP_INLINE void *modperl_hash_tied_object(pTHX_ const char *classname,
SV *tsv);
Index: src/modules/perl/modperl_common_util.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_common_util.c,v
retrieving revision 1.2
diff -u -r1.2 modperl_common_util.c
--- src/modules/perl/modperl_common_util.c 22 Jun 2004 22:34:10 -0000 1.2
+++ src/modules/perl/modperl_common_util.c 12 Jul 2004 18:54:23 -0000
@@ -36,9 +36,9 @@
gv_stashpv(classname, TRUE)));
}
-MP_INLINE void *modperl_hash_tied_object(pTHX_
- const char *classname,
- SV *tsv)
+MP_INLINE SV *modperl_hash_tied_object_rv(pTHX_
+ const char *classname,
+ SV *tsv)
{
if (sv_derived_from(tsv, classname)) {
if (SVt_PVHV == SvTYPE(SvRV(tsv))) {
@@ -47,7 +47,7 @@
if (SvMAGICAL(hv)) {
if ((mg = mg_find(hv, PERL_MAGIC_tied))) {
- return (void *)MgObjIV(mg);
+ return mg->mg_obj;
}
else {
Perl_warn(aTHX_ "Not a tied hash: (magic=%c)", mg);
@@ -58,7 +58,7 @@
}
}
else {
- return (void *)SvObjIV(tsv);
+ return tsv;
}
}
else {
@@ -67,7 +67,17 @@
"(expecting an %s derived object)", classname);
}
- return NULL;
+ return &PL_sv_undef;
+}
+MP_INLINE void *modperl_hash_tied_object(pTHX_
+ const char *classname,
+ SV *tsv)
+{
+ SV *rv = modperl_hash_tied_object_rv(aTHX_ classname, tsv);
+ if (SvROK(rv))
+ return (void *)SvIVX(SvRV(rv));
+ else
+ return NULL;
}
/* same as Symbol::gensym() */
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Table/APR__Table.h,v
retrieving revision 1.11
diff -u -r1.11 APR__Table.h
--- xs/APR/Table/APR__Table.h 4 Mar 2004 06:01:10 -0000 1.11
+++ xs/APR/Table/APR__Table.h 12 Jul 2004 18:54:26 -0000
@@ -13,7 +13,6 @@
* limitations under the License.
*/
-#define mpxs_APR__Table_FETCH apr_table_get
#define mpxs_APR__Table_STORE apr_table_set
#define mpxs_APR__Table_DELETE apr_table_unset
#define mpxs_APR__Table_CLEAR apr_table_clear
@@ -122,54 +121,74 @@
static MP_INLINE const char *mpxs_APR__Table_NEXTKEY(pTHX_ SV *tsv, SV *key)
{
- apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
+ apr_table_t *t;
+ SV *rv = modperl_hash_tied_object_rv(aTHX_ "APR::Table", tsv);
+ if (!SvROK(rv)) {
+ Perl_croak(aTHX_ "Usage: $table->NEXTKEY($key): "
+ "first argument not an APR::Table object");
+ }
+ t = (apr_table_t *)SvIVX(SvRV(rv));
if (apr_is_empty_table(t)) {
return NULL;
}
-
- if (mpxs_apr_table_iterix(tsv) < apr_table_elts(t)->nelts) {
- return mpxs_apr_table_nextkey(t, tsv);
+ if (key == NULL) {
+ mpxs_apr_table_iterix(rv) = 0; /* reset iterator index */
}
-
+ if (mpxs_apr_table_iterix(rv) < apr_table_elts(t)->nelts) {
+ return mpxs_apr_table_nextkey(t, rv);
+ }
+ mpxs_apr_table_iterix(rv) = 0;
return NULL;
}
static MP_INLINE const char *mpxs_APR__Table_FIRSTKEY(pTHX_ SV *tsv)
{
- mpxs_apr_table_iterix(tsv) = 0; /* reset iterator index */
-
return mpxs_APR__Table_NEXTKEY(aTHX_ tsv, Nullsv);
}
static XS(MPXS_apr_table_get)
{
dXSARGS;
+ SV *rv;
if (items != 2) {
Perl_croak(aTHX_ "Usage: $table->get($key)");
}
+ rv = modperl_hash_tied_object_rv(aTHX_ "APR::Table", ST(0));
+ if (!SvROK(rv)) {
+ Perl_croak(aTHX_ "Usage: $table->get($key): "
+ "first argument not an APR::Table object");
+ }
+
mpxs_PPCODE({
- APR__Table t = modperl_hash_tied_object(aTHX_ "APR::Table", ST(0));
+ APR__Table t = (APR__Table) SvIVX(SvRV(rv));
const char *key = (const char *)SvPV_nolen(ST(1));
+ int i = mpxs_apr_table_iterix(rv);
+ const apr_array_header_t *arr;
+ apr_table_entry_t *elts;
if (!t) {
XSRETURN_UNDEF;
}
-
- if (GIMME_V == G_SCALAR) {
- const char *val = apr_table_get(t, key);
+ arr = apr_table_elts(t);
+ elts = (apr_table_entry_t *)arr->elts;
- if (val) {
- XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+ if (GIMME_V == G_SCALAR) {
+ if (i > 0 && i <= arr->nelts
+ && !strcasecmp(key, elts[i-1].key))
+ {
+ XPUSHs(sv_2mortal(newSVpv(elts[i-1].val, 0)));
+ }
+ else {
+ const char *val = apr_table_get(t, key);
+ if (val) {
+ XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+ }
}
}
else {
- const apr_array_header_t *arr = apr_table_elts(t);
- apr_table_entry_t *elts = (apr_table_entry_t *)arr->elts;
- int i;
-
for (i = 0; i < arr->nelts; i++) {
if (!elts[i].key || strcasecmp(elts[i].key, key)) {
continue;
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]