This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Split Perl_do_openn() into Perl_do_open_raw() and Perl_do_open6().
authorNicholas Clark <nick@ccl4.org>
Sun, 2 Mar 2014 08:26:29 +0000 (09:26 +0100)
committerNicholas Clark <nick@ccl4.org>
Wed, 19 Mar 2014 09:57:53 +0000 (10:57 +0100)
Perl_do_open_raw() handles the as_raw part of Perl_do_openn().
Perl_do_open6() handles the !as_raw part of Perl_do_openn().
do_open6() isn't a great name, but I can't see an obvious concise name that
covers 2 arg open, 3 arg open, piped open, implicit fork, and layers.

doio.c
embed.fnc
embed.h
proto.h

diff --git a/doio.c b/doio.c
index 85b3a2d..2a58da3 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -127,6 +127,24 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
              I32 num_svs)
 {
+    PERL_ARGS_ASSERT_DO_OPENN;
+
+    if (as_raw) {
+        /* sysopen style args, i.e. integer mode and permissions */
+
+       if (num_svs != 0) {
+           Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld",
+                      (long) num_svs);
+       }
+        return do_open_raw(gv, oname, len, rawmode, rawperm);
+    }
+    return do_open6(gv, oname, len, supplied_fp, svp, num_svs);
+}
+
+bool
+Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len,
+                 int rawmode, int rawperm)
+{
     dVAR;
     PerlIO *saveifp;
     PerlIO *saveofp;
@@ -136,12 +154,11 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
     IO * const io = openn_setup(gv, mode, &saveifp, &saveofp, &savefd, &savetype);
     int writing = 0;
     PerlIO *fp;
-    bool was_fdopen = FALSE;
-    char *type  = NULL;
 
-    PERL_ARGS_ASSERT_DO_OPENN;
+    PERL_ARGS_ASSERT_DO_OPEN_RAW;
 
-    if (as_raw) {
+    /* For ease of blame back to 5.000, keep the existing indenting. */
+    {
         /* sysopen style args, i.e. integer mode and permissions */
        STRLEN ix = 0;
        const int appendtrunc =
@@ -157,10 +174,6 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
        int ismodifying;
         SV *namesv;
 
-       if (num_svs != 0) {
-           Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld",
-                      (long) num_svs);
-       }
        /* It's not always
 
           O_RDONLY 0
@@ -192,10 +205,32 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
        namesv = newSVpvn_flags(oname, len, SVs_TEMP);
-       type = NULL;
-       fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, 1, &namesv);
+       fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1, &namesv);
     }
-    else {
+    return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
+                         savetype, writing, 0, NULL);
+}
+
+bool
+Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
+              PerlIO *supplied_fp, SV **svp, U32 num_svs)
+{
+    dVAR;
+    PerlIO *saveifp;
+    PerlIO *saveofp;
+    int savefd;
+    char savetype;
+    char mode[PERL_MODE_MAX];  /* file mode ("r\0", "rb\0", "ab\0" etc.) */
+    IO * const io = openn_setup(gv, mode, &saveifp, &saveofp, &savefd, &savetype);
+    int writing = 0;
+    PerlIO *fp;
+    bool was_fdopen = FALSE;
+    char *type  = NULL;
+
+    PERL_ARGS_ASSERT_DO_OPEN6;
+
+    /* For ease of blame back to 5.000, keep the existing indenting. */
+    {
        /* Regular (non-sys) open */
        char *name;
        STRLEN olen = len;
index 44c9211..567e587 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -408,6 +408,11 @@ Ap |bool   |do_openn       |NN GV *gv|NN const char *oname|I32 len \
                                |int as_raw|int rawmode|int rawperm \
                                |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \
                                |I32 num
+Mp     |bool   |do_open_raw    |NN GV *gv|NN const char *oname|STRLEN len \
+                               |int rawmode|int rawperm
+Mp     |bool   |do_open6       |NN GV *gv|NN const char *oname|STRLEN len \
+                               |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \
+                               |U32 num
 : Used in pp_hot.c and pp_sys.c
 p      |bool   |do_print       |NULLOK SV* sv|NN PerlIO* fp
 : Used in pp_sys.c
diff --git a/embed.h b/embed.h
index 9e0ba97..0ddaca7 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define do_eof(a)              Perl_do_eof(aTHX_ a)
 #define do_execfree()          Perl_do_execfree(aTHX)
 #define do_ncmp(a,b)           Perl_do_ncmp(aTHX_ a,b)
+#define do_open6(a,b,c,d,e,f)  Perl_do_open6(aTHX_ a,b,c,d,e,f)
+#define do_open_raw(a,b,c,d,e) Perl_do_open_raw(aTHX_ a,b,c,d,e)
 #define do_print(a,b)          Perl_do_print(aTHX_ a,b)
 #define do_readline()          Perl_do_readline(aTHX)
 #define do_seek(a,b,c)         Perl_do_seek(aTHX_ a,b,c)
diff --git a/proto.h b/proto.h
index 41f8eb0..dd5edde 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -934,6 +934,12 @@ PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #define PERL_ARGS_ASSERT_DO_OPEN       \
        assert(gv); assert(name)
 
+PERL_CALLCONV bool     Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, PerlIO *supplied_fp, SV **svp, U32 num)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_DO_OPEN6      \
+       assert(gv); assert(oname)
+
 PERL_CALLCONV bool     Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
@@ -941,6 +947,12 @@ PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int as
 #define PERL_ARGS_ASSERT_DO_OPEN9      \
        assert(gv); assert(name); assert(svs)
 
+PERL_CALLCONV bool     Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, int rawmode, int rawperm)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_DO_OPEN_RAW   \
+       assert(gv); assert(oname)
+
 PERL_CALLCONV bool     Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);