perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Torsten Förtsch <torsten.foert...@gmx.net>
Subject Re: [patch]avoid closing fd 0/1
Date Wed, 07 Apr 2010 15:08:39 GMT
On Sunday 04 April 2010 18:43:29 Torsten Förtsch wrote:
> This is another idea to solve the problem. We used to save and restore the 
> file handle. Why not simply localize it?
> 
[...]
> Opinions?
> 
> How do I build a modperl that uses tied IO?
> 
This version compiles cleanly and passes all tests for a perl 5.10.1 compiled 
with and without useperlio.

Index: src/modules/perl/modperl_io.c
===================================================================
--- src/modules/perl/modperl_io.c	(revision 931462)
+++ 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,28 @@
     /* 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 GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+{
+    modperl_io_perlio_override_stdhandle(aTHX_ r, O_RDONLY);
+    return NULL;
+}
 
-        if (do_open9(handle_orig, ">&", 2, FALSE,
-                     O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
-            err = get_sv("!", TRUE);
-        }
+MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+{
+    modperl_io_perlio_override_stdhandle(aTHX_ r, O_WRONLY);
+    return NULL;
+}
 
-        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_ GV *handle)
+{
+    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_ GV *handle)
+{
+    modperl_io_perlio_restore_stdhandle(aTHX_ O_WRONLY);
 }
+
Index: t/response/TestModperl/stdfd.pm
===================================================================
--- t/response/TestModperl/stdfd.pm	(revision 0)
+++ t/response/TestModperl/stdfd.pm	(revision 0)
@@ -0,0 +1,41 @@
+package TestModperl::stdfd;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+    my $r = shift;
+
+    $r->handler($r->main ? 'perl-script' : 'modperl');
+    return Apache2::Const::OK;
+}
+
+sub handler {
+    my $r = shift;
+
+    return Apache2::Const::OK if $r->main;
+
+    my @fds=(fileno(STDIN), fileno(STDOUT));
+
+    $r->lookup_uri($r->uri)->run;
+
+    $r->print("1..2\n");
+    $r->print((fileno(STDIN)==$fds[0] ? '' : 'not ').
+              "ok 1 - fileno(STDIN)=".fileno(STDIN)." expected $fds[0]\n");
+    $r->print((fileno(STDOUT)==$fds[1] ? '' : 'not ').
+              "ok 2 - fileno(STDOUT)=".fileno(STDOUT)." expected $fds[1]\n");
+
+    return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd
+PerlFixupHandler    TestModperl::stdfd::fixup
+PerlResponseHandler TestModperl::stdfd
Index: t/response/TestModperl/stdfd2.pm
===================================================================
--- t/response/TestModperl/stdfd2.pm	(revision 0)
+++ t/response/TestModperl/stdfd2.pm	(revision 0)
@@ -0,0 +1,44 @@
+package TestModperl::stdfd2;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+    my $r = shift;
+
+    $r->handler($r->main ? 'perl-script' : 'modperl');
+    return Apache2::Const::OK;
+}
+
+sub handler {
+    my $r = shift;
+
+    return Apache2::Const::OK if $r->main;
+
+    local *STDIN;
+    open STDIN, '<', $INC{'TestModperl/stdfd2.pm'}
+        or die "Cannot open $INC{'TestModperl/stdfd2.pm'}";
+    scalar readline STDIN for(1..2);
+
+    my $expected=$.;
+
+    $r->lookup_uri($r->uri)->run;
+
+    $r->print("1..1\n");
+    $r->print(($.==$expected ? '' : 'not ').
+              "ok 1 - \$.=$. expected $expected\n");
+
+    return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd2
+PerlFixupHandler    TestModperl::stdfd2::fixup
+PerlResponseHandler TestModperl::stdfd2

Torsten Förtsch

-- 
Need professional modperl support? Hire me! (http://foertsch.name)

Like fantasy? http://kabatinte.net

Mime
View raw message