You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by ge...@apache.org on 2002/08/07 21:39:00 UTC
cvs commit: modperl STATUS
geoff 2002/08/07 12:39:00
Modified: . STATUS
Log:
added bug report for print not looking at $\
Revision Changes Path
1.21 +8 -1 modperl/STATUS
Index: STATUS
===================================================================
RCS file: /home/cvs/modperl/STATUS,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- STATUS 23 May 2002 04:21:06 -0000 1.20
+++ STATUS 7 Aug 2002 19:39:00 -0000 1.21
@@ -21,6 +21,13 @@
Needs Patch or Further Investigation
+ * $r->print() ignores $\
+ Report: http://marc.theaimsgroup.com/?l=apache-modperl&m=102874705105904&w=2
+ Status:
+ not sure what to do with this, just sv_catpvn(sv, $\, 1) in Apache.xs's print()?
+ does that handle everything? (assuming I can figure out how to dig out
+ what's in $\) is this really important? --Geoff
+
* make test fails when a wrong combination of URI and LWP are
installed. (e.g. lwp 5.64 and URI 1.09). LWP's Makefile.PL
requires the right URI version, but certain binary distributors
[1.0] $\ and $, [Was: Re: cvs commit: modperl STATUS]
Posted by Steve Grazzini <gr...@nyc.rr.com>.
On Fri, Aug 09, 2002 at 01:47:50PM -0400, Geoffrey Young wrote:
> geoff@apache.org 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: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: cvs commit: modperl STATUS
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
geoff@apache.org 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...
--Geoff
Index: Apache.xs
===================================================================
RCS file: /home/cvspublic/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.125
diff -u -r1.125 Apache.xs
--- Apache.xs 6 Jul 2001 20:33:35 -0000 1.125
+++ Apache.xs 9 Aug 2002 17:44:00 -0000
@@ -1160,6 +1160,7 @@
PREINIT:
int i;
+ int sent = 0;
char * buffer;
STRLEN len;
@@ -1170,7 +1171,6 @@
XSRETURN_IV(0);
for(i = 1; i <= items - 1; i++) {
- int sent = 0;
SV *sv = SvROK(ST(i)) && (SvTYPE(SvRV(ST(i))) == SVt_PV) ?
(SV*)SvRV(ST(i)) : ST(i);
buffer = SvPV(sv, len);
@@ -1197,6 +1197,13 @@
RETVAL += sent;
#endif
}
+
+ buffer = SvPV(GvSV(gv_fetchpv("\\", TRUE, SVt_PV)), len);
+
+ if((sent = rwrite(buffer, len, r)) < 0) {
+ rwrite_neg_trace(r);
+ }
+ RETVAL += sent;
OUTPUT:
RETVAL
Re: cvs commit: modperl STATUS
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
geoff@apache.org 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...
--Geoff
Index: Apache.xs
===================================================================
RCS file: /home/cvspublic/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.125
diff -u -r1.125 Apache.xs
--- Apache.xs 6 Jul 2001 20:33:35 -0000 1.125
+++ Apache.xs 9 Aug 2002 17:44:00 -0000
@@ -1160,6 +1160,7 @@
PREINIT:
int i;
+ int sent = 0;
char * buffer;
STRLEN len;
@@ -1170,7 +1171,6 @@
XSRETURN_IV(0);
for(i = 1; i <= items - 1; i++) {
- int sent = 0;
SV *sv = SvROK(ST(i)) && (SvTYPE(SvRV(ST(i))) == SVt_PV) ?
(SV*)SvRV(ST(i)) : ST(i);
buffer = SvPV(sv, len);
@@ -1197,6 +1197,13 @@
RETVAL += sent;
#endif
}
+
+ buffer = SvPV(GvSV(gv_fetchpv("\\", TRUE, SVt_PV)), len);
+
+ if((sent = rwrite(buffer, len, r)) < 0) {
+ rwrite_neg_trace(r);
+ }
+ RETVAL += sent;
OUTPUT:
RETVAL
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org