Stas Bekman <[EMAIL PROTECTED]> 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:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
