On Wednesday 31 March 2010 16:43:04 Torsten Förtsch wrote:
> This one is much simpler.
>
This is another idea to solve the problem. We used to save and restore the
file handle. Why not simply localize it?
The caller of the override/restore functions already creates the opening and
closing braces:
/* need to create a block around the IO setup so the temp vars
* will be automatically cleaned up when we are done with IO */
ENTER;SAVETMPS;
h_stdin = modperl_io_override_stdin(aTHX_ r);
h_stdout = modperl_io_override_stdout(aTHX_ r);
...
modperl_io_restore_stdin(aTHX_ h_stdin);
modperl_io_restore_stdout(aTHX_ h_stdout);
FREETMPS;LEAVE;
So the only thing the overriding function has to do is
dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT");
save_gp(handle, 1);
The restoring function does noting to restore the handle. It is left to perl.
Would that be better than messing with the perlio internals?
The patch below implements the idea for the perlio case. But I think it can be
used in the tie case as well. Thus, the code can be simplified and a few
#ifdefs can be eliminated.
Opinions?
How do I build a modperl that uses tied IO?
Index: src/modules/perl/modperl_io.c
===================================================================
--- src/modules/perl/modperl_io.c (revision 930668)
+++ src/modules/perl/modperl_io.c (working copy)
@@ -104,137 +104,36 @@
sv_unmagic(TIEHANDLE_SV(handle), PERL_MAGIC_tiedscalar);
}
-MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+MP_INLINE static void
+modperl_io_perlio_override_stdhandle(pTHX_ request_rec *r, int mode)
{
- dHANDLE("STDIN");
+ dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT");
int status;
- GV *handle_save = (GV*)Nullsv;
SV *sv = sv_newmortal();
- MP_TRACE_o(MP_FUNC, "start");
+ MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
- /* if STDIN is open, dup it, to be restored at the end of response */
- if (handle && SvTYPE(handle) == SVt_PVGV &&
- IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
- handle_save = gv_fetchpv(Perl_form(aTHX_
- "Apache2::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
+ save_gp(handle, 1);
- /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
- status = do_open(handle_save, "<&STDIN", 7, FALSE,
- O_RDONLY, 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDIN: %" SVf, get_sv("!",
TRUE));
- }
-
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDIN must be closed before it can
- * be reopened */
- do_close(handle, TRUE);
- }
-
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, "<:Apache2", 9, FALSE, O_RDONLY,
- 0, Nullfp, sv, 1);
+ status = do_open9(handle, mode == O_RDONLY ? "<:Apache2" : ">:Apache2",
+ 9, FALSE, mode, 0, Nullfp, sv, 1);
if (status == 0) {
- Perl_croak(aTHX_ "Failed to open STDIN: %" SVf, get_sv("!", TRUE));
+ Perl_croak(aTHX_ "Failed to open STD%s: %" SVf,
+ mode == O_RDONLY ? "IN" : "OUT", get_sv("!", TRUE));
}
- MP_TRACE_o(MP_FUNC, "end");
-
- return handle_save;
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode==O_RDONLY ? "IN" : "OUT");
}
-/* XXX: refactor to merge with the previous function */
-MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+MP_INLINE static void
+modperl_io_perlio_restore_stdhandle(pTHX_ int mode)
{
- dHANDLE("STDOUT");
- int status;
- GV *handle_save = (GV*)Nullsv;
- SV *sv = sv_newmortal();
+ GV *handle_orig = gv_fetchpv(mode == O_RDONLY ? "STDIN" : "STDOUT",
+ FALSE, SVt_PVIO);
- MP_TRACE_o(MP_FUNC, "start");
+ MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
- /* if STDOUT is open, dup it, to be restored at the end of response */
- if (handle && SvTYPE(handle) == SVt_PVGV &&
- IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
- handle_save = gv_fetchpv(Perl_form(aTHX_
- "Apache2::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
-
- /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
- status = do_open(handle_save, ">&STDOUT", 8, FALSE,
- O_WRONLY, 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDOUT: %" SVf, get_sv("!",
TRUE));
- }
-
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDOUT must be closed before it can
- * be reopened */
- do_close(handle, TRUE);
- }
-
- sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, ">:Apache2", 9, FALSE, O_WRONLY,
- 0, Nullfp, sv, 1);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to open STDOUT: %" SVf, get_sv("!", TRUE));
- }
-
- MP_TRACE_o(MP_FUNC, "end");
-
- /* XXX: shouldn't we preserve the value STDOUT had before it was
- * overridden? */
- IoFLUSH_off(handle); /* STDOUT's $|=0 */
-
- return handle_save;
-
-}
-
-MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
-{
- GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
-
- MP_TRACE_o(MP_FUNC, "start");
-
- /* close the overriding filehandle */
- do_close(handle_orig, FALSE);
-
- /*
- * open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
- * close STDIN_SAVED;
- */
- if (handle != (GV*)Nullsv) {
- SV *err = Nullsv;
-
- MP_TRACE_o(MP_FUNC, "restoring STDIN");
-
- if (do_open9(handle_orig, "<&", 2, FALSE,
- O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
- err = get_sv("!", TRUE);
- }
-
- do_close(handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache2::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
-
- if (err != Nullsv) {
- Perl_croak(aTHX_ "Failed to restore STDIN: %" SVf, err);
- }
- }
-
- MP_TRACE_o(MP_FUNC, "end");
-}
-
-MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
-{
- GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
-
- MP_TRACE_o(MP_FUNC, "start");
-
/* since closing unflushed STDOUT may trigger a subrequest
* (e.g. via mod_include), resulting in potential another response
* handler call, which may try to close STDOUT too. We will
@@ -242,7 +141,8 @@
* level STDOUT is attempted to be closed. To prevent this
* situation always explicitly flush STDOUT, before reopening it.
*/
- if (GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
+ if (mode != O_RDONLY &&
+ GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
(PerlIO_flush(IoOFP(GvIOn(handle_orig))) == -1)) {
Perl_croak(aTHX_ "Failed to flush STDOUT: %" SVf, get_sv("!", TRUE));
}
@@ -250,28 +150,26 @@
/* close the overriding filehandle */
do_close(handle_orig, FALSE);
- /*
- * open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!";
- * close STDOUT_SAVED;
- */
- if (handle != (GV*)Nullsv) {
- SV *err = Nullsv;
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT");
+}
- MP_TRACE_o(MP_FUNC, "restoring STDOUT");
+MP_INLINE void modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+{
+ modperl_io_perlio_override_stdhandle(aTHX_ r, O_RDONLY);
+}
- if (do_open9(handle_orig, ">&", 2, FALSE,
- O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
- err = get_sv("!", TRUE);
- }
+MP_INLINE void modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+{
+ modperl_io_perlio_override_stdhandle(aTHX_ r, O_WRONLY);
+}
- do_close(handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache2::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
+MP_INLINE void modperl_io_perlio_restore_stdin(pTHX)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ O_RDONLY);
+}
- if (err != Nullsv) {
- Perl_croak(aTHX_ "Failed to restore STDOUT: %" SVf, err);
- }
- }
-
- MP_TRACE_o(MP_FUNC, "end");
+MP_INLINE void modperl_io_perlio_restore_stdout(pTHX)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ O_WRONLY);
}
+
Index: src/modules/perl/modperl_io.h
===================================================================
--- src/modules/perl/modperl_io.h (revision 930668)
+++ src/modules/perl/modperl_io.h (working copy)
@@ -51,13 +51,13 @@
MP_INLINE void modperl_io_handle_untie(pTHX_ GV *handle);
-MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r);
+MP_INLINE void modperl_io_perlio_override_stdin(pTHX_ request_rec *r);
-MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r);
+MP_INLINE void modperl_io_perlio_override_stdout(pTHX_ request_rec *r);
-MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle);
+MP_INLINE void modperl_io_perlio_restore_stdin(pTHX);
-MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle);
+MP_INLINE void modperl_io_perlio_restore_stdout(pTHX);
#if defined(MP_IO_TIE_SFIO)
/* XXX */
Index: src/modules/perl/mod_perl.c
===================================================================
--- src/modules/perl/mod_perl.c (revision 930669)
+++ src/modules/perl/mod_perl.c (working copy)
@@ -1056,7 +1056,6 @@
int modperl_response_handler_cgi(request_rec *r)
{
MP_dDCFG;
- GV *h_stdin, *h_stdout;
apr_status_t retval, rc;
MP_dRCFG;
#ifdef USE_ITHREADS
@@ -1091,8 +1090,8 @@
/* need to create a block around the IO setup so the temp vars
* will be automatically cleaned up when we are done with IO */
ENTER;SAVETMPS;
- h_stdin = modperl_io_override_stdin(aTHX_ r);
- h_stdout = modperl_io_override_stdout(aTHX_ r);
+ modperl_io_override_stdin(aTHX_ r);
+ modperl_io_override_stdout(aTHX_ r);
modperl_env_request_tie(aTHX_ r);
@@ -1102,8 +1101,8 @@
modperl_perl_global_request_restore(aTHX_ r);
- modperl_io_restore_stdin(aTHX_ h_stdin);
- modperl_io_restore_stdout(aTHX_ h_stdout);
+ modperl_io_restore_stdin(aTHX);
+ modperl_io_restore_stdout(aTHX);
FREETMPS;LEAVE;
#ifdef USE_ITHREADS
Torsten Förtsch
--
Need professional modperl support? Hire me! (http://foertsch.name)
Like fantasy? http://kabatinte.net
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscr...@perl.apache.org
For additional commands, e-mail: dev-h...@perl.apache.org
