You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by "Philippe M . Chiasson" <go...@cpan.org> on 2001/09/11 13:07:19 UTC
[Patch] APR::Table->do(sub)
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 <go...@cpan.org>
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}'
Re: [Patch] APR::Table->do(sub)
Posted by Doug MacEachern <do...@covalent.net>.
On Tue, 11 Sep 2001, Philippe M . Chiasson wrote:
> + /* Skip entries in our filter list */
> + if (tdc_data->filter){
> + if(apr_table_get(tdc_data->filter,key)){
> + return 1;
> + }
> + }
should be skipping all _but_ those in the filter list, right?
just changing to:
if (!apr_table_get(...)) {
should do the trick.
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [Patch] APR::Table->do(sub)
Posted by "Philippe M . Chiasson" <go...@cpan.org>.
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'
}
]
},
Re: [Patch] APR::Table->do(sub)
Posted by Doug MacEachern <do...@covalent.net>.
On Tue, 11 Sep 2001, Philippe M . Chiasson wrote:
> As promised, APR::Table->do()
cool!
> 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 ?
you don't need to send xs/tables diffs, i can just regenerate them here.
>
> 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 ?
you can pick something shorter, something like mpxs_table_cb_data_t is
fine.
> * Still doesn't feel like the right way to put it in xs/maps/apr_functions.map....but works
see previous comment:
apr_table_do | mpxs_
to setup the call to mpxs_apr_table_do
> * 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.
i think this addressed in your second patch (haven't looked yet).
> +#define _mpxs_APR__Table_do_callback_prototype (int (*)(void *, const char *, const char *))
this should be a typedef.
> +static MP_INLINE
> +void mpxs_APR__Table_do(apr_table_t *table, SV *sub)
> +{
> + dTHX; /*XXX*/
dTHX; should be avoided whenever possible. if you setup the .map as
discussed:
apr_table_do | mpxs_
mpxs_apr_table_do
will be passed aTHX
there's still minor style issues:
if(...){
vs.
if (...) {
and
("one","two","three")
vs.
("one", "two", "three")
otherwise, looking good!
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org