[patch] APR::Table::get list context

[Stas Bekman]

- this patch implements the list context get

Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.3
diff -u -r1.3 table.pm
--- t/response/TestAPR/table.pm 2001/09/25 19:44:03     1.3
+++ t/response/TestAPR/table.pm 2001/09/27 17:15:39
@@ -14,7 +14,7 @@
 sub handler {
     my $r = shift;

-    plan $r, tests => 16;
+    plan $r, tests => 17;

     my $table = APR::Table::make($r->pool, $TABLE_SIZE);

@@ -69,8 +69,14 @@

         ok $table->{'foo'} = 'bar';

+        # scalar context
         ok $table->{'foo'} eq 'bar';

+        # list context
+        $table->add(foo => 'tar');
+        my @array = $table->get('foo');
+        ok @array == 2 && $array[0] eq 'bar' && $array[1] eq 'tar';
+
         ok delete $table->{'foo'} || 1;

         ok not exists $table->{'foo'};
@@ -81,7 +87,7 @@

         $filter_count = 0;
         foreach my $key (sort keys %$table) {
-            my_filter($key,$table->{$key});
+            my_filter($key, $table->{$key});
         }
         ok $filter_count == $TABLE_SIZE;
     }
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Table/APR__Table.h,v
retrieving revision 1.4
diff -u -r1.4 APR__Table.h
--- xs/APR/Table/APR__Table.h   2001/09/25 19:44:03     1.4
+++ xs/APR/Table/APR__Table.h   2001/09/27 17:15:39
@@ -126,3 +126,44 @@

     return mpxs_APR__Table_NEXTKEY(tsv, Nullsv);
 }
+
+static XS(MPXS_apr_table_get)
+{
+    dXSARGS;
+    APR__Table t = modperl_hash_tied_object(aTHX_ "APR::Table", ST(0));
+    const char *key = (const char *)SvPV_nolen(ST(1));
+
+    if (items != 2) {
+        Perl_croak(aTHX_ "Usage: $table->get($key)");
+    }
+
+    mpxs_PPCODE({
+        t = modperl_hash_tied_object(aTHX_ "APR::Table", ST(0));
+        key = (const char *)SvPV_nolen(ST(1));
+
+        if (!t) {
+            XSRETURN_UNDEF;
+        }
+
+        if(GIMME_V == G_SCALAR) {
+            const char *val = apr_table_get(t, key);
+            if (val) {
+                XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+            }
+        }
+        else {
+            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;
+                }
+                XPUSHs(sv_2mortal(newSVpv(elts[i].val,0)));
+            }
+        }
+    });
+
+}
+
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.22
diff -u -r1.22 apr_functions.map
--- xs/maps/apr_functions.map   2001/09/25 19:44:03     1.22
+++ xs/maps/apr_functions.map   2001/09/27 17:15:39
@@ -184,7 +184,7 @@
  apr_table_add
 -apr_table_addn
  apr_table_do | mpxs_ | ...
- apr_table_get
+ apr_table_get | MPXS_ | ...
  apr_table_merge
 -apr_table_mergen
  apr_table_set
@@ -198,6 +198,7 @@
  mpxs_APR__Table_FIRSTKEY
  mpxs_APR__Table_NEXTKEY
  mpxs_APR__Table_EXISTS
+

 !MODULE=APR::File
 -apr_file_open



_____________________________________________________________________
Stas Bekman              JAm_pH     --   Just Another mod_perl Hacker
http://stason.org/       mod_perl Guide  http://perl.apache.org/guide
mailto:[EMAIL PROTECTED]   http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/



---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]