Stas Bekman <[EMAIL PROTECTED]> 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: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
