perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject Re: [Fwd: Re: [rfc] APR::Table & polymorphic values]
Date Thu, 05 Jun 2003 09:35:42 GMT
Joe Schaefer wrote:
> Stas Bekman <stas@stason.org> writes:
> 
> [...]
> 
> 
>>so we can't simply alias FETCH to apr_table_get, the following sort
>>of works (but breaks some other things):
>>
>>static MP_INLINE
>>const char *mpxs_APR__Table_FETCH(pTHX_ SV *tsv, const char *key)
>>{
>>     apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
>>
>>     if (!t) {
>>         return "";
>>     }
>>
>>     if (!mpxs_apr_table_iterix(tsv)) {
>>         return apr_table_get(t, key);
>>     }
>>     else {
>>         const apr_array_header_t *arr = apr_table_elts(t);
>>         apr_table_entry_t *elts  = (apr_table_entry_t *)arr->elts;
>>         return elts[mpxs_apr_table_iterix(tsv)-1].val;
>>     }
>>}
>>
>>I'm not sure if it's a good idea though.
> 
> 
> Probably not as it is- testing mpxs_apr_table_iterix(tsv)
> isn't what you want.  I think you really need to know something
> about the calling context (iterator call or actual lookup?),
> but I'm not sure if perl provides enough info.
> 
> It might be easiest to just change the comment at the bottom
> of the docs, and just recommend do() for iterating over
> the table values.  Short of that, someone might instead wrap
> apr_table_elts() as an array.  For apreq, I'd just be concerned 
> about how the value attribute of apr_table_entry_t were 
> typemapped.

Check this out. It seems to work now. Here is a complete patch. You will have 
to rebuild the whole thing, because of the API change.

Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/cvs/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	5 Jun 2003 09:33:04 -0000
@@ -15,7 +15,7 @@
  sub handler {
      my $r = shift;

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

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

@@ -35,6 +35,14 @@
         $array[1] eq 'tar' &&
         $array[2] eq 'kar';

+    my $c = 0;
+    while (my ($a, $b) = each %$table) {
+        warn ("$a $b\n");
+        ok $a eq 'foo';
+        ok $b eq $array[$c];
+        $c++;
+    }
+
      ok $table->unset('foo') || 1;

      ok not defined $table->get('foo');
@@ -105,7 +113,7 @@
      my ($key,$value) = @_;
      $filter_count++;
      unless ($key eq chr($value+97)) {
-        die "arguments I received are bogus($key,$value)";
+        die "arguments I received are bogus($key,$value)".chr($value+97);
      }
      return 1;
  }
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/cvs/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	5 Jun 2003 09:33:05 -0000
@@ -1,4 +1,4 @@
-#define mpxs_APR__Table_FETCH   apr_table_get
+//#define mpxs_APR__Table_FETCH   mpxs_apr_table_FETCH1
  #define mpxs_APR__Table_STORE   apr_table_set
  #define mpxs_APR__Table_DELETE  apr_table_unset
  #define mpxs_APR__Table_CLEAR   apr_table_clear
@@ -117,6 +117,7 @@
          return mpxs_apr_table_nextkey(t, tsv);
      }

+    mpxs_apr_table_iterix(tsv) = 0; /* done */
      return NULL;
  }

@@ -145,7 +146,8 @@

          if (GIMME_V == G_SCALAR) {
              const char *val = apr_table_get(t, key);
-
+            fprintf(stderr, "SCALAR CONTEXT\n");
+
              if (val) {
                  XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
              }
@@ -154,6 +156,7 @@
              const apr_array_header_t *arr = apr_table_elts(t);
              apr_table_entry_t *elts  = (apr_table_entry_t *)arr->elts;
              int i;
+            fprintf(stderr, "LIST CONTEXT\n");

              for (i = 0; i < arr->nelts; i++) {
                  if (!elts[i].key || strcasecmp(elts[i].key, key)) {
@@ -164,4 +167,23 @@
          }
      });

+}
+
+static MP_INLINE
+const char *mpxs_APR__Table_FETCH(pTHX_ SV *tsv, const char *key)
+{
+    apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
+
+    if (!t) {
+        return "";
+    }
+
+    if (!mpxs_apr_table_iterix(tsv)) {
+        return apr_table_get(t, key);
+    }
+    else {
+        const apr_array_header_t *arr = apr_table_elts(t);
+        apr_table_entry_t *elts  = (apr_table_entry_t *)arr->elts;
+        return elts[mpxs_apr_table_iterix(tsv)-1].val;
+    }
  }
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/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	5 Jun 2003 09:33:05 -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/cvs/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	5 Jun 2003 09:33:05 -0000
@@ -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' => 'const char *',
+        'name' => 'key'
+      }
+    ]
+  },
+  {
+    'return_type' => 'const char *',
      'name' => 'mpxs_APR__Table_NEXTKEY',
      'attr' => [
        'static',


__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com


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


Mime
View raw message