Tuomo Salo wrote:
> Under mod_perl2 the return value of print seems to be the number of
> bytes printed. I run across a legacy app (a registry script), that
> frequently used the following idiom:
>
>
> print(CGI::redirect("url_to_error_page")) and return if $error;
>
>
> While this is obviously a stupid way to write, it seems ok since the
> perldoc for print says: "Prints a string or a list of strings. Returns
> true if successful."
> Now the redirection will be performed, and an empty string is passed to
> print. print has been overridden by mod_perl2, and will now return the
> number of bytes written, that is, 0. The "and" will naturally
> short-circuit, and the "return" will never be reached.
ok, try this patch.
--Geoff
Index: xs/maps/modperl_functions.map
===================================================================
--- xs/maps/modperl_functions.map (revision 111510)
+++ xs/maps/modperl_functions.map (working copy)
@@ -48,7 +48,7 @@
MODULE=Apache::RequestIO PACKAGE=Apache::RequestRec
SV *:DEFINE_TIEHANDLE | | SV *:stashsv, SV *:sv=Nullsv
- apr_size_t:DEFINE_PRINT | | ...
+ SV *:DEFINE_PRINT | | ...
apr_size_t:DEFINE_PRINTF | | ...
SV *:DEFINE_BINMODE | | request_rec *:r
SV *:DEFINE_CLOSE | | request_rec *:r
Index: xs/Apache/RequestIO/Apache__RequestIO.h
===================================================================
--- xs/Apache/RequestIO/Apache__RequestIO.h (revision 111510)
+++ xs/Apache/RequestIO/Apache__RequestIO.h (working copy)
@@ -75,8 +75,8 @@
}
static MP_INLINE
-apr_size_t mpxs_Apache__RequestRec_print(pTHX_ I32 items,
- SV **MARK, SV **SP)
+SV *mpxs_Apache__RequestRec_print(pTHX_ I32 items,
+ SV **MARK, SV **SP)
{
modperl_config_req_t *rcfg;
request_rec *r;
@@ -95,7 +95,7 @@
mpxs_output_flush(r, rcfg, "Apache::RequestIO::print");
- return bytes;
+ return bytes ? newSVuv(bytes) : newSVpvn("0E0", 3);
}
static MP_INLINE
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm (revision 111510)
+++ xs/tables/current/ModPerl/FunctionTable.pm (working copy)
@@ -6766,7 +6766,7 @@
]
},
{
- 'return_type' => 'apr_size_t',
+ 'return_type' => 'SV *',
'name' => 'mpxs_Apache__RequestRec_print',
'args' => [
{
Index: t/response/TestModperl/print.pm
===================================================================
--- t/response/TestModperl/print.pm (revision 111510)
+++ t/response/TestModperl/print.pm (working copy)
@@ -12,7 +12,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 3;
+ plan $r, tests => 6;
binmode STDOUT; #Apache::RequestRec::BINMODE (noop)
@@ -20,8 +20,23 @@
ok 2;
- printf "ok %d\n", 3;
+ {
+ # print should return true on success, even
+ # if it sends no data.
+ my $rc = print '';
+ ok ($rc);
+ ok ($rc == 0); # 0E0 is still numerically 0
+ }
+
+ {
+ my $rc = print "# 11 bytes\n"; # don't forget the newline
+
+ ok ($rc == 11);
+ }
+
+ printf "ok %d\n", 6;
+
Apache::OK;
}
Index: t/response/TestAPI/request_rec.pm
===================================================================
--- t/response/TestAPI/request_rec.pm (revision 111510)
+++ t/response/TestAPI/request_rec.pm (working copy)
@@ -95,7 +95,7 @@
{
local $| = 0;
ok t_cmp $r->print("# buffered\n"), 11, "buffered print";
- ok t_cmp $r->print(), 0, "buffered print";
+ ok t_cmp $r->print(), "0E0", "buffered print";
local $| = 1;
my $string = "# not buffered\n";
--
Report problems: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html
List etiquette: http://perl.apache.org/maillist/email-etiquette.html
