Here is an attempt at a simple implementation of $r->print(), copied mostly
from mpxs_ap_rvputs().
A few things worth noting:
1. It does support $|
2. It doesn't have timeouts like 1.3 used to have (is it needed anymore?)
3. Should most the tests use $r->print() in the future ? (perl -pi ...)
4. While looking for sent_headers, discovered it's done and works already ;-)
5. Somehow, I had to copy and paste bits of rvputs. Maybe a simple refactoring
would make one call the other instaed (or yet one more macro, if speed is an issue)
6. In Apache__RequiestIO.h :
#if 0
#define MP_USE_AP_RWRITE
#endif
#ifdef MP_USE_AP_RWRITE
[...]
#ifdef MP_USE_AP_RWRITE
mpxs_rwrite_loop(mpxs_call_rwrite, r);
#else
mpxs_write_loop(modperl_wbucket_write, &rcfg->wbucket);
#endif
That bit got me quite confused... Any hints please?
Anyways, here is the patch.
P.S. Next on my list APR::Table->do()
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/10 07:18:09
@@ -68,9 +68,6 @@
however, $r->sendfile is a new function that opens the file for you
and calls ap_send_fd() underneath.
-$r->print:
-does not yet honor $|
-
$r->{hard,reset,soft,kill}_timeout:
do not exist in 2.0. should be deprecated. consider adding noops in
Apache::compat
Index: xs/Apache/RequestIO/Apache__RequestIO.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/Apache/RequestIO/Apache__RequestIO.h,v
retrieving revision 1.12
diff -u -I'$Id' -I'$Revision' -r1.12 Apache__RequestIO.h
--- xs/Apache/RequestIO/Apache__RequestIO.h 2001/06/20 23:59:37 1.12
+++ xs/Apache/RequestIO/Apache__RequestIO.h 2001/09/10 07:18:09
@@ -23,6 +23,38 @@
#endif
+static MP_INLINE apr_size_t mpxs_ap_rvprint(pTHX_ I32 items,
+ SV ** MARK, SV ** SP)
+{
+ modperl_config_srv_t *scfg;
+ modperl_config_req_t *rcfg;
+ request_rec *r;
+
+ /* bytes must be called bytes */
+ apr_size_t bytes = 0;
+
+ /* this also magically assings to r ;-) */
+ mpxs_usage_va_1(r, "$r->print(...)");
+
+ /* XXX: should check if http headers were sent already, and send if not. */
+ rcfg = modperl_config_req_get(r);
+ scfg = modperl_config_srv_get(r->server);
+
+ /* XXX: also, I wish I could call rvputs directly... */
+#ifdef MP_USE_AP_RWRITE
+ mpxs_rwrite_loop(mpxs_call_rwrite, r);
+#else
+ mpxs_write_loop(modperl_wbucket_write, &rcfg->wbucket);
+#endif
+
+ /* if ($|) */
+ if( IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH ){
+ ap_rflush(r);
+ }
+
+ return bytes;
+}
+
static MP_INLINE apr_size_t mpxs_ap_rvputs(pTHX_ I32 items,
SV **MARK, SV **SP)
{
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apache_functions.map,v
retrieving revision 1.28
diff -u -I'$Id' -I'$Revision' -r1.28 apache_functions.map
--- xs/maps/apache_functions.map 2001/09/08 18:26:46 1.28
+++ xs/maps/apache_functions.map 2001/09/10 07:18:09
@@ -83,6 +83,7 @@
~ap_rprintf
!ap_rputc
~ap_rputs
+ ap_rvprint | mpxs_ | ... | print
ap_rvputs | mpxs_ | ... | puts
-ap_vrprintf
Index: xs/tables/current/Apache/FunctionTable.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/tables/current/Apache/FunctionTable.pm,v
retrieving revision 1.17
diff -u -I'$Id' -I'$Revision' -r1.17 FunctionTable.pm
--- xs/tables/current/Apache/FunctionTable.pm 2001/09/06 16:41:29 1.17
+++ xs/tables/current/Apache/FunctionTable.pm 2001/09/10 07:18:10
@@ -4093,6 +4093,20 @@
},
{
'return_type' => 'int',
+ 'name' => 'ap_rvprint',
+ 'args' => [
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => '...',
+ 'name' => 'arg1'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'int',
'name' => 'ap_rwrite',
'args' => [
{
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/10 07:18:10
@@ -3712,6 +3712,28 @@
]
},
{
+ 'return_type' => 'apr_size_t',
+ 'name' => 'mpxs_ap_rvprint',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'I32',
+ 'name' => 'items'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'mark'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'sp'
+ }
+ ]
+ },
+ {
'return_type' => 'int',
'name' => 'mpxs_ap_unescape_url',
'args' => [
Index: t/response/TestAPI/request_rec.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPI/request_rec.pm,v
retrieving revision 1.5
diff -u -I'$Id' -I'$Revision' -r1.5 request_rec.pm
--- t/response/TestAPI/request_rec.pm 2001/09/08 18:26:46 1.5
+++ t/response/TestAPI/request_rec.pm 2001/09/10 07:18:10
@@ -8,7 +8,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 37;
+ plan $r, tests => 40;
#Apache->request($r); #PerlOptions +GlobalRequest takes care
my $gr = Apache->request;
@@ -85,9 +85,18 @@
#content_languages
#user
-
+
#no_cache
ok $r->no_cache || 1;
+
+ {
+ local $| = 0;
+ ok 6 == $r->print("gozer\n");
+ ok 0 == $r->print();
+ local $| = 1;
+ ok 11 == $r->print('g','o','z','e','r',"gozer","\n");
+ }
+
#no_local_copy
Index: t/response/TestApache/scanhdrs.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestApache/scanhdrs.pm,v
retrieving revision 1.1
diff -u -I'$Id' -I'$Revision' -r1.1 scanhdrs.pm
--- t/response/TestApache/scanhdrs.pm 2001/05/08 21:08:46 1.1
+++ t/response/TestApache/scanhdrs.pm 2001/09/10 07:18:10
@@ -9,15 +9,15 @@
sub handler {
my $r = shift;
- print "Status: 200 Bottles of beer on the wall\n";
- print 'X-Perl-Module', ': ', __PACKAGE__;
- print "\r\n";
- print "Content-type: text/test-";
- print "output\n";
- print "\n";
+ $r->print("Status: 200 Bottles of beer on the wall\n");
+ $r->print('X-Perl-Module', ': ', __PACKAGE__);
+ $r->print ("\r\n");
+ $r->print ("Content-type: text/test-");
+ $r->print ("output\n");
+ $r->print( "\n");
plan $r, tests => 1;
- print "ok 1\n";
+ $r->print("ok 1\n");
Apache::OK;
}
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
Ignorance is bliss only as long as you keep your mouth
shut.
-- Larry Wall
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
PGP signature
