perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Joe Schaefer <joe+gm...@sunstarsys.com>
Subject Re: [Fwd: Re: [rfc] APR::Table & polymorphic values]
Date Fri, 06 Jun 2003 04:19:29 GMT
Stas Bekman <stas@stason.org> writes:

> I'd hate to take the joy of adding these wonderful features away from
> Philippe,  who's now busy wrestling with mod_perl 1.28 release, but
> once done will certainly love to do those. Right Philippe?

Curiosity got the better of me.  Here's a patch that seems to 
work (all tests pass), but it sure ain't pretty.  Hopefully
it'll help once Philippe gets some free tuits.

Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.5
diff -u -r1.5 table.pm
--- t/response/TestAPR/table.pm	11 Apr 2002 11:08:44 -0000	1.5
+++ t/response/TestAPR/table.pm	6 Jun 2003 04:07:33 -0000
@@ -15,7 +15,7 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 17;
+    plan $r, tests => 26;
 
     my $table = APR::Table::make($r->pool, $TABLE_SIZE);
 
@@ -34,6 +34,14 @@
        $array[0] eq 'bar' &&
        $array[1] eq 'tar' &&
        $array[2] eq 'kar';
+
+    my $c = 0;
+    while (my($a, $b) = each %$table) {
+        ok $a eq 'foo';
+        ok $b eq $array[$c];
+        ok not defined $table->{'bar'};
+        $c++;
+    }
 
     ok $table->unset('foo') || 1;
 
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Table/APR__Table.h,v
retrieving revision 1.10
diff -u -r1.10 APR__Table.h
--- xs/APR/Table/APR__Table.h	4 Jun 2003 02:31:56 -0000	1.10
+++ xs/APR/Table/APR__Table.h	6 Jun 2003 04:07:33 -0000
@@ -1,4 +1,4 @@
-#define mpxs_APR__Table_FETCH   apr_table_get
+//#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
@@ -105,25 +105,45 @@
    ((apr_table_entry_t *) \
      apr_table_elts(t)->elts)[mpxs_apr_table_iterix(sv)++].key
 
-static MP_INLINE const char *mpxs_APR__Table_NEXTKEY(pTHX_ SV *tsv, SV *key)
+
+static MP_INLINE SV *mpxs_APR__Table_NEXTKEY(pTHX_ SV *tsv, SV *key)
 {
     apr_table_t *t = mp_xs_sv2_APR__Table(tsv); 
-
     if (apr_is_empty_table(t)) {
-        return NULL;
+        return Nullsv;
     }
 
     if (mpxs_apr_table_iterix(tsv) < apr_table_elts(t)->nelts) {
-        return mpxs_apr_table_nextkey(t, tsv);
-    }
+        apr_table_entry_t *e = ((apr_table_entry_t *)
+            apr_table_elts(t)->elts) + mpxs_apr_table_iterix(tsv)++;
+        STRLEN len = strlen(e->key);
+        SV *sv = newSV(0);
+
+        /* XXX: really nasty hack: set the numeric value of the key
+         * to represent a pointer to the corresponding val.
+         * We mark SvEND with another copy of the val's address
+         * as a means of confirming SvIVX really repesents a 
+         * pointer.
+         */
+        SvUPGRADE(sv, SVt_PVIV);
+        SvGROW(sv, len + 3*sizeof(IV) + 1);
+        memcpy(SvPVX(sv), e->key, len);
+        SvCUR_set(sv, len);
+        SvEND(sv)[0] = 0;
+        SvIVX(sv) = (IV) e->val;
+        ((IV *)SvEND(sv))[1] = SvIVX(sv) = (IV) e->val;
+        SvPOK_on(sv);
+        SvIOK_on(sv);
 
-    return NULL;
+        return sv;
+    }
+    mpxs_apr_table_iterix(tsv) = 0; /* done */
+    return &PL_sv_undef;
 }
 
-static MP_INLINE const char *mpxs_APR__Table_FIRSTKEY(pTHX_ SV *tsv)
+static MP_INLINE SV *mpxs_APR__Table_FIRSTKEY(pTHX_ SV *tsv)
 {
     mpxs_apr_table_iterix(tsv) = 0; /* reset iterator index */
-
     return mpxs_APR__Table_NEXTKEY(aTHX_ tsv, Nullsv);
 }
 
@@ -164,4 +184,30 @@
         }
     });
     
+}
+
+static MP_INLINE
+const char *mpxs_APR__Table_FETCH(pTHX_ SV *tsv, SV *sv)
+{
+    apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
+    MAGIC *mg;
+    if (!t) {
+        return NULL;
+    }
+
+    /* XXX: really nasty hack, part 2: check for 
+     * an SV coming from mpxs_APR_TABLE_NEXT.  If
+     * it is, we take the return value directly 
+     * from SvIVX.
+     */
+
+    if (SvPOK(sv) && SvIOK(sv) && 
+        SvLEN(sv) == SvCUR(sv) + 3*sizeof(IV) + 1 &&
+        ((IV *)SvEND(sv))[1] == SvIVX(sv))
+    {
+        return (const char *)SvIVX(sv);
+    }   
+    else {
+        return apr_table_get(t, SvPV_nolen(sv));
+    }
 }
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.52
diff -u -r1.52 apr_functions.map
--- xs/maps/apr_functions.map	15 Apr 2003 08:39:52 -0000	1.52
+++ xs/maps/apr_functions.map	6 Jun 2003 04:07:34 -0000
@@ -246,10 +246,11 @@
 -apr_table_setn
  apr_table_unset
 -apr_table_vdo
- const char *:DEFINE_FETCH | | apr_table_t *:t, const char *:key
+#const char *:DEFINE_FETCH | | apr_table_t *:t, const char *:key
  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
+ mpxs_APR__Table_FETCH
  mpxs_APR__Table_FIRSTKEY
  mpxs_APR__Table_NEXTKEY
  mpxs_APR__Table_EXISTS
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.116
diff -u -r1.116 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm	4 Jun 2003 16:50:38 -0000	1.116
+++ xs/tables/current/ModPerl/FunctionTable.pm	6 Jun 2003 04:07:39 -0000
@@ -4958,7 +4958,7 @@
     ]
   },
   {
-    'return_type' => 'const char *',
+    'return_type' => 'SV *',
     'name' => 'mpxs_APR__Table_FIRSTKEY',
     'attr' => [
       'static',
@@ -4977,6 +4977,28 @@
   },
   {
     'return_type' => 'const char *',
+    'name' => 'mpxs_APR__Table_FETCH',
+    'attr' => [
+      'static',
+      '__inline__'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'tsv'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'key'
+      }
+    ]
+  },
+  {
+    'return_type' => 'SV *',
     'name' => 'mpxs_APR__Table_NEXTKEY',
     'attr' => [
       'static',

-- 
Joe Schaefer


---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message