On Fri, Aug 09, 2002 at 01:47:50PM -0400, Geoffrey Young wrote:
> [EMAIL PROTECTED] wrote:
> > geoff 2002/08/07 12:39:00
> >
> > Modified: . STATUS
> > Log:
> > added bug report for print not looking at $\
>
> the below patch seems to work, though I need to trace through the
> rwrite_neg_trace() stuff to see what it actually does :) no
> guarantees here, just some fiddling.
>
> at any rate, if somebody who knows more about the perl API and XS
> wants to use this as a starting point, feel free. I'm still unsure
> about whether we want to implement this at all, but I had some free
> time and...
>
Here's one to handle $, and $\.
$r->write() continues to ignore them (like the builtin write()),
and both vars are localized each time a handler is called.
Steve
diff -Nru modperl-cvs/src/modules/perl/Apache.xs
modperl-grazz/src/modules/perl/Apache.xs
--- modperl-cvs/src/modules/perl/Apache.xs Fri Jul 6 16:33:35 2001
+++ modperl-grazz/src/modules/perl/Apache.xs Sat Aug 10 19:10:54 2002
@@ -1131,14 +1131,47 @@
sv_setiv(sendh, 0);
}
else {
- CV *cv = GvCV(gv_fetchpv("Apache::write_client", FALSE, SVt_PVCV));
+ /* partial inline of write() so print() can respect $\ and $, */
+ int i;
soft_timeout("mod_perl: Apache->print", r);
- PUSHMARK(mark);
-#ifdef PERL_OBJECT
- (void)(*CvXSUB(cv))(cv, pPerl); /* &Apache::write_client; */
-#else
- (void)(*CvXSUB(cv))(aTHXo_ cv); /* &Apache::write_client; */
-#endif
+
+ ITEMS:
+ for(i=1; i<items; i++) {
+ SV *sv = SvROK(ST(i)) && (SvTYPE(SvRV(ST(i))) == SVt_PV) ?
+ (SV*)SvRV(ST(i)) : ST(i);
+ STRLEN len;
+ char *buffer = SvPV(sv, len);
+#ifdef APACHE_SSL
+ while(len > 0) {
+ int sent = rwrite(buffer,
+ len < HUGE_STRING_LEN ? len : HUGE_STRING_LEN,
+ r);
+ if(sent < 0) {
+ rwrite_neg_trace(r);
+ break ITEMS;
+ }
+ buffer += sent;
+ len -= sent;
+ }
+#else
+ if(rwrite(buffer, len, r) < 0) {
+ rwrite_neg_trace(r);
+ break;
+ }
+#endif
+ if (i == items-1) {
+ if(PL_orslen && rwrite(PL_ors, PL_orslen, r) < 0) {
+ rwrite_neg_trace(r);
+ break;
+ }
+ }
+ else {
+ if(PL_ofslen && rwrite(PL_ofs, PL_ofslen, r) < 0) {
+ rwrite_neg_trace(r);
+ break;
+ }
+ }
+ }
if(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) /* if $| != 0; */
#if MODULE_MAGIC_NUMBER >= 19970103
diff -Nru modperl-cvs/src/modules/perl/mod_perl.c
modperl-grazz/src/modules/perl/mod_perl.c
--- modperl-cvs/src/modules/perl/mod_perl.c Thu May 23 00:35:16 2002
+++ modperl-grazz/src/modules/perl/mod_perl.c Sat Aug 10 18:58:53 2002
@@ -888,6 +888,24 @@
perl_stdout2client(r);
perl_stdin2client(r);
+ /* local $\ */
+ save_generic_pvref(&PL_ors);
+ save_iv((IV*) &PL_orslen);
+
+ if (PL_orslen) {
+ PL_ors = Nullch;
+ PL_orslen = 0;
+ }
+
+ /* local $, */
+ save_generic_pvref(&PL_ofs);
+ save_iv((IV*) &PL_ofslen);
+
+ if (PL_ofslen) {
+ PL_ofs = Nullch;
+ PL_ofslen = 0;
+ }
+
if(!cfg) {
cfg = perl_create_request_config(r->pool, r->server);
set_module_config(r->request_config, &perl_module, cfg);
diff -Nru modperl-cvs/t/internal/rprint.t modperl-grazz/t/internal/rprint.t
--- modperl-cvs/t/internal/rprint.t Wed Dec 31 19:00:00 1969
+++ modperl-grazz/t/internal/rprint.t Sat Aug 10 18:27:27 2002
@@ -0,0 +1,11 @@
+
+use Apache::test;
+
+my @input = split /;/, fetch "/perl/rprint.pl";
+print "1.." . @input . "\n";
+
+my $i = 0;
+foreach (@input) {
+ my ($wanted, $got) = split /=/;
+ test ++$i, $wanted eq $got;
+}
diff -Nru modperl-cvs/t/net/perl/rprint.pl modperl-grazz/t/net/perl/rprint.pl
--- modperl-cvs/t/net/perl/rprint.pl Wed Dec 31 19:00:00 1969
+++ modperl-grazz/t/net/perl/rprint.pl Sat Aug 10 18:27:27 2002
@@ -0,0 +1,22 @@
+#!perl
+my $r = shift;
+$r->send_http_header("text/plain");
+
+if ($r->args) {
+ $, = ",";
+ $r->write("1,2,3=");
+ print 1..3;
+ $r->write(";");
+}
+else {
+ $\ = "\n";
+ $r->write("123\n=");
+ print 1..3;
+ $r->write(";");
+
+ $r->lookup_uri("rprint.pl?1=1")->run;
+
+ $r->write("123\n=");
+ print 1..3;
+ $r->write(";");
+}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
