As promised, APR::Table->do()
A few things worth noting:
* [OT] make source_scan gives me a huge diff and I have to manually weed out what's
not
related to my stuff before sending, annoying ... why ?
APR::Table->do("my_sub") || APR::Table->do(sub {...});
* Namespace issue. I am not sure about _mpxs_APR__Table_do_callback_data... it's
clear, but it's long. But I did it because that data shouldn't be used by anybody
but mpxs_APR__Table_do. Better suggestions ?
* Still doesn't feel like the right way to put it in
xs/maps/apr_functions.map....but works
* Filtering
* In 1.3, used to populate a table with the extra arguments passed to do and
filter
in the C callback, just before calling the perl callback.
* apr_table_vdo supports filtering, but it accepts a va_list as argument and uses
va_arg to fetch the elements. Question, is there a way to create something that
apr_table_vdo would swallow as a va_list and on wich va_arg(vp, char *) would
work?
If so, please tell me, as it would skip many operations and speed things up a
bit.
Gozer out.
Index: todo/api.txt
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 api.txt
--- todo/api.txt 2001/09/08 18:26:46 1.2
+++ todo/api.txt 2001/09/11 10:50:00
@@ -9,8 +9,6 @@
$r->headers_out->{KEY} is not currently supported
might want to make this optional, disabled by default
-missing: APR::Table->do
-
$r->finfo:
need apr_finfo_t <-> struct stat conversion (might already be there,
haven't looked close enough yet)
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apr_functions.map,v
retrieving revision 1.18
diff -u -I'$Id' -I'$Revision' -r1.18 apr_functions.map
--- xs/maps/apr_functions.map 2001/09/10 06:42:51 1.18
+++ xs/maps/apr_functions.map 2001/09/11 10:50:00
@@ -183,7 +183,6 @@
apr_table_overlay | | base, overlay, p
apr_table_add
-apr_table_addn
- apr_table_do
apr_table_get
apr_table_merge
-apr_table_mergen
@@ -191,6 +190,7 @@
-apr_table_setn
apr_table_unset
-apr_table_vdo
+mpxs_APR__Table_do
!MODULE=APR::File
-apr_file_open
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.23
diff -u -I'$Id' -I'$Revision' -r1.23 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 2001/09/08 18:26:46 1.23
+++ xs/tables/current/ModPerl/FunctionTable.pm 2001/09/11 10:50:00
@@ -3240,6 +3240,20 @@
{
'type' => 'apr_bucket *',
'name' => 'bucket'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'void',
+ 'name' => 'mpxs_APR__Table_do',
+ 'args' => [
+ {
+ 'type' => 'apr_table_t *',
+ 'name' => 'table'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'sub'
}
]
},
--- /dev/null Sat Mar 24 12:37:44 2001
+++ t/response/TestAPR/table.pm Tue Sep 11 18:40:57 2001
@@ -0,0 +1,74 @@
+package TestAPR::table;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+
+use Apache::Const -compile => 'OK';
+use APR::Table ();
+
+my $filter_count;
+my $TABLE_SIZE = 20;
+
+sub handler {
+ my $r = shift;
+
+ plan $r, tests => 8;
+
+ my $table = APR::Table::make($r->pool,16);
+
+ ok (UNIVERSAL::isa($table,'APR::Table'));
+
+ ok $table->set('foo','bar') || 1;
+
+ ok $table->get('foo') eq 'bar';
+
+ ok $table->unset('foo') || 1;
+
+ ok not defined $table->get('foo');
+
+ for(1..$TABLE_SIZE)
+ {
+ $table->set(chr($_+97),$_);
+ }
+
+ #Simple filtering
+ $table->do("my_filter");
+ ok $filter_count == $TABLE_SIZE;
+
+ #Filtering aborting in the middle
+ $filter_count = 0;
+ $table->do("my_filter_stop");
+ ok $filter_count == int($TABLE_SIZE)/2;
+
+ #Filtering with anon sub
+ $filter_count=0;
+ $table->do(sub {
+ my ($key,$value) = @_;
+ $filter_count++;
+ die "arguments I recieved are bogus($key,$value)" unless $key eq
+chr($value+97);
+ return 1;
+ }
+ );
+ ok $filter_count == $TABLE_SIZE;
+
+ Apache::OK;
+}
+
+sub my_filter {
+ my ($key,$value) = @_;
+ $filter_count++;
+ die "arguments I recieved are bogus($key,$value)" unless $key eq chr($value+97);
+ return 1;
+}
+
+sub my_filter_stop {
+ my ($key,$value) = @_;
+ $filter_count++;
+ die "arguments I recieved are bogus($key,$value)" unless $key eq chr($value+97);
+ #print "Stop_Filtered $key,$value ($filter_count)\n";
+ return 0 if ($filter_count == int($TABLE_SIZE)/2);
+ return 1;
+}
+1;
--- /dev/null Sat Mar 24 12:37:44 2001
+++ xs/APR/Table/APR__Table.h Tue Sep 11 18:45:37 2001
@@ -0,0 +1,52 @@
+typedef struct {
+ SV *cv;
+ apr_table_t *filter; /*XXX: or maybe a mgv ? */
+} _mpxs_APR__Table_do_callback_data;
+
+#define _mpxs_APR__Table_do_callback_prototype (int (*)(void *, const char *, const
+char *))
+
+static int _mpxs_APR__Table_do_callback(_mpxs_APR__Table_do_callback_data *tdc_data,
+const char *key, const char *val)
+{
+ dTHX;
+ dSP;
+ int rv=0;
+
+ /* Skip completely if something is wrong */
+ if ((!tdc_data) || (!tdc_data->cv) || (!key) || (!val))
+ return 0;
+
+ /* XXX: We would filter here */
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpv((char *)key,0)));
+ XPUSHs(sv_2mortal(newSVpv((char *)val,0)));
+ PUTBACK;
+ rv = call_sv(tdc_data->cv, 0);
+ SPAGAIN;
+ rv = (rv == 1) ? POPi : 1;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ /* rv of 0 aborts the traversal */
+ return rv;
+}
+
+static MP_INLINE
+void mpxs_APR__Table_do(apr_table_t *table, SV *sub)
+{
+ dTHX; /*XXX*/
+ _mpxs_APR__Table_do_callback_data tdc_data;
+
+ tdc_data.cv=sub;
+
+ /*XXX: would be nice to be able to call apr_table_vdo directly,
+ but I don't think it's possible to create/populate something
+ that smells like a va_list with our list of filters specs
+ */
+
+ apr_table_do(_mpxs_APR__Table_do_callback_prototype _mpxs_APR__Table_do_callback,
+(void *) &tdc_data, table, NULL);
+ return;
+}
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
Tonight I just can't face the Muzak.
-- Larry Wall
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
PGP signature
