On Tue, Sep 11, 2001 at 07:07:19PM +0800, Philippe M . Chiasson wrote:
> 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.
This patch now implements filtering like mod_perl pre 2.0 used to do it.
Everything I said above still applies to this patch.
Gozer out for the night.
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 15:01:54
@@ -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 15:02:06
@@ -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
--- /dev/null Sat Mar 24 12:37:44 2001
+++ xs/APR/Table/APR__Table.h Tue Sep 11 22:57:13 2001
@@ -0,0 +1,77 @@
+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 *))
+
+#define mp_xs_sv2_table mp_xs_sv2_APR__Table
+
+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;
+
+ /* Skip entries in our filter list */
+ if (tdc_data->filter){
+ if(apr_table_get(tdc_data->filter,key)){
+ return 1;
+ }
+ }
+
+ 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(pTHX_ I32 items, SV **MARK, SV **SP)
+{
+ dAX; /*XXX*/
+
+ apr_table_t *table;
+ SV *sub;
+ _mpxs_APR__Table_do_callback_data tdc_data;
+
+ mpxs_usage_va_2(table,sub,"$table->do(sub,[@filter])");
+
+ tdc_data.cv=sub;
+ tdc_data.filter=NULL;
+
+ if(items > 2){
+ STRLEN len;
+ tdc_data.filter = apr_table_make(table->a.pool,items-2);
+ while ( MARK <= SP ){
+ apr_table_set(tdc_data.filter,SvPV(*MARK,len),"1");
+ MARK++;
+ }
+ }
+
+ /*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);
+
+ /* Free tdc_data.filter */
+
+ return;
+}
--- /dev/null Sat Mar 24 12:37:44 2001
+++ t/response/TestAPR/table.pm Tue Sep 11 22:51:01 2001
@@ -0,0 +1,79 @@
+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 => 9;
+
+ my $table = APR::Table::make($r->pool,$TABLE_SIZE);
+
+ 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
+ $filter_count = 0;
+ $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;
+
+ $filter_count=0;
+ $table->do("my_filter","c","b","e");
+ ok $filter_count == $TABLE_SIZE-3;
+
+ 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;
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 15:04:36
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Sat Sep 8 11:16:43 2001
+# ! Tue Sep 11 19:50:41 2001
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3240,6 +3240,28 @@
{
'type' => 'apr_bucket *',
'name' => 'bucket'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'void',
+ 'name' => 'mpxs_APR__Table_do',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'I32',
+ 'name' => 'items'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'mark'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'sp'
}
]
},
PGP signature
