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]

Reply via email to