perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject [patch] $table->as_string() and "$table"
Date Thu, 29 Nov 2001 10:50:15 GMT
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  <gozer@cpan.org>
  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}'

Mime
View raw message