Following patch includes $r->as_string() and "$string" to dump a table in a format like: key='value'\n keyn='valuen'\n
Also renamed mpxs_table_do_cb_data_t.cv to mpxs_table_do_cb_data_t.sv
for clarity, as I needed it again for the as_string() implementation
to store a simple SV*
Also, wish it could be easier to use 'overload' from C/XS
/home/gozer/sources/mod_perl2/deps/perl-13279/bin/perl build/cvsdiff
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/APR/Table/APR__Table.h,v
retrieving revision 1.7
diff -u -I'$Id' -I'$Revision' -r1.7 APR__Table.h
--- xs/APR/Table/APR__Table.h 12 Nov 2001 22:14:36 -0000 1.7
+++ xs/APR/Table/APR__Table.h 29 Nov 2001 10:21:53 -0000
@@ -4,7 +4,7 @@
#define mpxs_APR__Table_CLEAR apr_table_clear
typedef struct {
- SV *cv;
+ SV *sv;
apr_hash_t *filter;
PerlInterpreter *perl;
} mpxs_table_do_cb_data_t;
@@ -20,7 +20,7 @@
int rv = 0;
/* Skip completely if something is wrong */
- if (!(tdata && tdata->cv && key && val)) {
+ if (!(tdata && tdata->sv && key && val)) {
return 0;
}
@@ -39,7 +39,7 @@
XPUSHs(sv_2mortal(newSVpv(val,0)));
PUTBACK;
- rv = call_sv(tdata->cv, 0);
+ rv = call_sv(tdata->sv, 0);
SPAGAIN;
rv = (1 == rv) ? POPi : 1;
PUTBACK;
@@ -60,7 +60,7 @@
mpxs_usage_va_2(table, sub, "$table->do(sub, [@filter])");
- tdata.cv = sub;
+ tdata.sv = sub;
tdata.filter = NULL;
#ifdef USE_ITHREADS
tdata.perl = aTHX;
@@ -163,4 +163,28 @@
}
});
+}
+
+static int sv_str_header(void *data, const char *k, const char *v)
+{
+ mpxs_table_do_cb_data_t *tdata = (mpxs_table_do_cb_data_t *)data;
+ dTHXa(tdata->perl);
+ sv_catpvf(tdata->sv, "%s='%s'\n", k, v);
+ return 1;
+}
+
+static MP_INLINE
+SV *mpxs_APR__Table_as_string(pTHX_ SV *tsv)
+{
+ SV *string = newSVpv("", 0);
+ mpxs_table_do_cb_data_t tdata;
+
+#ifdef USE_ITHREADS
+ tdata.perl = aTHX;
+#endif
+ tdata.sv = string;
+
+ apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
+ apr_table_do(&sv_str_header, &tdata, t, NULL);
+ return string;
}
Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPR/table.pm,v
retrieving revision 1.4
diff -u -I'$Id' -I'$Revision' -r1.4 table.pm
--- t/response/TestAPR/table.pm 28 Sep 2001 17:20:32 -0000 1.4
+++ t/response/TestAPR/table.pm 29 Nov 2001 10:21:54 -0000
@@ -14,7 +14,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 17;
+ plan $r, tests => 19;
my $table = APR::Table::make($r->pool, $TABLE_SIZE);
@@ -24,6 +24,9 @@
# scalar context
ok $table->get('foo') eq 'bar';
+
+ ok $table->as_string() eq "foo='bar'\n";
+ ok "$table" eq "foo='bar'\n";
# add + list context
$table->add(foo => 'tar');
Index: docs/src/api/mod_perl-2.0/APR/Table.pod
===================================================================
RCS file: /home/anoncvs/mod_perl-docs-cvs/src/api/mod_perl-2.0/APR/Table.pod,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 Table.pod
--- docs/src/api/mod_perl-2.0/APR/Table.pod 22 Oct 2001 15:47:17 -0000 1.2
+++ docs/src/api/mod_perl-2.0/APR/Table.pod 29 Nov 2001 10:21:54 -0000
@@ -22,6 +22,10 @@
overlap($table_a, $table_b, $flags);
$new_table = overlay($table_base, $table_overlay, $pool);
+ #Dumping a table
+ print STDERR "Table looks like:\n" . $table->as_string();
+ print STDERR "Table looks like:$table";
+
#Tied Interface
$value = $table->{$key};
$table->{$key} = $value;
@@ -230,6 +234,21 @@
param C<$table_base>: The table to add at the end of the new table
return: A new table containing all of the data from the two passed in
+
+=item * as_string()
+
+ print STDERR $table->as_string();
+
+Returns a string representation of the table, usefull for debugging
+purposes.
+
+=item * "$table"
+
+ print STDERR "Table is : $table";
+
+Used in string context, a table will output a string representation
+of the table, usefull for debugging purposes.
+
=back
--- /dev/null Fri Aug 31 04:30:55 2001
+++ xs/APR/Table/Table_pm Thu Nov 29 18:04:01 2001
@@ -0,0 +1,5 @@
+use overload q("") => \&stringify;
+
+sub stringify {
+ return shift->as_string();
+}
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apr_functions.map,v
retrieving revision 1.25
diff -u -I'$Id' -I'$Revision' -r1.25 apr_functions.map
--- xs/maps/apr_functions.map 22 Oct 2001 01:52:06 -0000 1.25
+++ xs/maps/apr_functions.map 29 Nov 2001 10:21:54 -0000
@@ -198,6 +198,7 @@
mpxs_APR__Table_FIRSTKEY
mpxs_APR__Table_NEXTKEY
mpxs_APR__Table_EXISTS
+ mpxs_APR__Table_as_string
!MODULE=APR::File
-apr_file_open
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
/* When we have more time, we can teach the penguin to say
* "By your command" or "Activating turbo boost, Michael".
*/
-- Linux 2.2.16
/usr/src/linux/arch/sparc/prom/sun4prom.c
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
msg01950/pgp00000.pgp
Description: PGP signature
