Basic tweaks to do_open() type parsing to allow layer/discipline
Nick Ing-Simmons [Sat, 18 Nov 2000 14:06:20 +0000 (14:06 +0000)]
part to be isolated.

p4raw-id: //depot/perlio@7736

doio.c
perlio.c

diff --git a/doio.c b/doio.c
index 05ace5e..84a647f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -79,9 +79,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     int result;
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
+    char *type  = NULL;
+    char *deftype = NULL;
+    char mode[4];              /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
 
+    Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;                /* assume true if no fork */
 
+    /* Collect default raw/crlf info from the op */
     if (PL_op && PL_op->op_type == OP_OPEN) {
        /* set up disciplines */
        U8 flags = PL_op->op_private;
@@ -91,6 +96,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        out_crlf = (flags & OPpOPEN_OUT_CRLF);
     }
 
+    /* If currently open - close before we re-open */
     if (IoIFP(io)) {
        fd = PerlIO_fileno(IoIFP(io));
        if (IoTYPE(io) == IoTYPE_STD)
@@ -121,6 +127,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 
     if (as_raw) {
+        /* sysopen style args, i.e. integer mode and permissions */
+
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
        rawmode |= O_LARGEFILE;
 #endif
@@ -148,75 +156,79 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (fd == -1)
            fp = NULL;
        else {
-           char fpmode[4];
            STRLEN ix = 0;
-           if (result == O_RDONLY)
-               fpmode[ix++] = 'r';
+           if (result == O_RDONLY) {
+               mode[ix++] = 'r';
+           }
 #ifdef O_APPEND
            else if (rawmode & O_APPEND) {
-               fpmode[ix++] = 'a';
+               mode[ix++] = 'a';
                if (result != O_WRONLY)
-                   fpmode[ix++] = '+';
+                   mode[ix++] = '+';
            }
 #endif
            else {
                if (result == O_WRONLY)
-                   fpmode[ix++] = 'w';
+                   mode[ix++] = 'w';
                else {
-                   fpmode[ix++] = 'r';
-                   fpmode[ix++] = '+';
+                   mode[ix++] = 'r';
+                   mode[ix++] = '+';
                }
            }
            if (rawmode & O_BINARY)
-               fpmode[ix++] = 'b';
-           fpmode[ix] = '\0';
-           fp = PerlIO_fdopen(fd, fpmode);
+               mode[ix++] = 'b';
+           mode[ix] = '\0';
+           fp = PerlIO_fdopen(fd, mode);
            if (!fp)
                PerlLIO_close(fd);
        }
     }
     else {
-       char *type;
+       /* Regular (non-sys) open */
        char *oname = name;
-       STRLEN tlen;
        STRLEN olen = len;
-       char mode[4];           /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
-       int dodup;
+       char *tend;
+       int dodup = 0;
 
        type = savepvn(name, len);
-       tlen = len;
+       tend = type+len;
        SAVEFREEPV(type);
+       /* Loose trailing white space */
+       while (tend > type && isSPACE(tend[-1]))
+           *tend-- = '\0';
        if (num_svs) {
+           /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l;
            name = SvPV(svs, l) ;
            len = (I32)l;
            name = savepvn(name, len);
            SAVEFREEPV(name);
+           /*SUPPRESS 530*/
+           for (; isSPACE(*type); type++) ;
        }
        else {
-           while (tlen && isSPACE(type[tlen-1]))
-               type[--tlen] = '\0';
            name = type;
-           len = tlen;
+           len  = tend-type;
        }
-       mode[0] = mode[1] = mode[2] = mode[3] = '\0';
        IoTYPE(io) = *type;
-       if (*type == IoTYPE_RDWR && tlen > 1 && type[tlen-1] != IoTYPE_PIPE) { /* scary */
+       if (*type == IoTYPE_RDWR && (!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE)) { /* scary */
            mode[1] = *type++;
-           --tlen;
            writing = 1;
        }
 
        if (*type == IoTYPE_PIPE) {
-           if (num_svs && (tlen != 2 || type[1] != IoTYPE_STD)) {
-             unknown_desr:
-               Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
+           if (num_svs) {
+               if (type[1] != IoTYPE_STD) {
+                 unknown_desr:
+                   Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
+               }
+               type++;
            }
            /*SUPPRESS 530*/
-           for (type++, tlen--; isSPACE(*type); type++, tlen--) ;
+           for (type++; isSPACE(*type); type++) ;
            if (!num_svs) {
                name = type;
-               len = tlen;
+               len = tend-type;
            }
            if (*name == '\0') { /* command is missing 19990114 */
                dTHR;
@@ -228,7 +240,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            if (strNE(name,"-") || num_svs)
                TAINT_ENV();
            TAINT_PROPER("piped open");
-           if (name[len-1] == '|') {
+           if (!num_svs && name[len-1] == '|') {
                dTHR;
                name[--len] = '\0' ;
                if (ckWARN(WARN_PIPE))
@@ -249,7 +261,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */
                mode[0] = IoTYPE(io) = IoTYPE_APPEND;
                type++;
-               tlen--;
            }
            else
                mode[0] = 'w';
@@ -260,11 +271,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            else if (out_crlf)
                strcat(mode, "t");
 
-           if (num_svs && tlen != 1)
-               goto unknown_desr;
            if (*type == '&') {
                name = type;
              duplicity:
+               if (num_svs)
+                   goto unknown_desr;
                dodup = 1;
                name++;
                if (*name == '=') {
@@ -336,7 +347,9 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            else {
                /*SUPPRESS 530*/
                for (; isSPACE(*type); type++) ;
-               if (*type == IoTYPE_STD && !type[1]) {
+               if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
+                   /*SUPPRESS 530*/
+                   type++;
                    fp = PerlIO_stdout();
                    IoTYPE(io) = IoTYPE_STD;
                }
@@ -346,8 +359,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            }
        }
        else if (*type == IoTYPE_RDONLY) {
-           if (num_svs && tlen != 1)
-               goto unknown_desr;
            /*SUPPRESS 530*/
            for (type++; isSPACE(*type); type++) ;
            mode[0] = 'r';
@@ -360,25 +371,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                name = type;
                goto duplicity;
            }
-           if (*type == IoTYPE_STD && !type[1]) {
+           if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
+               /*SUPPRESS 530*/
+               type++;
                fp = PerlIO_stdin();
                IoTYPE(io) = IoTYPE_STD;
            }
            else
                fp = PerlIO_open((num_svs ? name : type), mode);
        }
-       else if (tlen > 1 && type[tlen-1] == IoTYPE_PIPE) {
+       else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) ||
+                (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) {
            if (num_svs) {
-               if (tlen != 2 || type[0] != IoTYPE_STD)
-                   goto unknown_desr;
+               type += 2;   /* skip over '-|' */
            }
            else {
-               type[--tlen] = '\0';
-               while (tlen && isSPACE(type[tlen-1]))
-                   type[--tlen] = '\0';
+               *--tend = '\0';
+               while (tend > type && isSPACE(tend[-1]))
+                   *--tend = '\0';
                /*SUPPRESS 530*/
                for (; isSPACE(*type); type++) ;
                name = type;
+               len  = tend-type;
            }
            if (*name == '\0') { /* command is missing 19990114 */
                dTHR;
@@ -494,20 +508,23 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 #endif
     IoIFP(io) = fp;
+    if (!num_svs) {
+       /* Need to supply default type info from open.pm */
+       type = NULL;
+    }
+    if (type) {
+       while (isSPACE(*type)) type++;
+       if (*type) {
+       }
+    }
+
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
        dTHR;
        if (IoTYPE(io) == IoTYPE_SOCKET
            || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
        {
-           char *mode;
-           if (out_raw)
-               mode = "wb";
-           else if (out_crlf)
-               mode = "wt";
-           else
-               mode = "w";
-
+           mode[0] = 'w';
            if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) {
                PerlIO_close(fp);
                IoIFP(io) = Nullfp;
index 05f589a..0ca7a7a 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -208,30 +208,10 @@ PerlIO_pop(PerlIO *f)
   }
 }
 
-#undef PerlIO_close
-int
-PerlIO_close(PerlIO *f)
-{
- int code = (*PerlIOBase(f)->tab->Close)(f);
- while (*f)
-  {
-   PerlIO_pop(f);
-  }
- return code;
-}
-
-
 /*--------------------------------------------------------------------------------------*/
-/* Given the abstraction above the public API functions */
+/* XS Interface for perl code */
 
-#undef PerlIO_fileno
-int
-PerlIO_fileno(PerlIO *f)
-{
- return (*PerlIOBase(f)->tab->Fileno)(f);
-}
-
-XS(XS_io_import)
+XS(XS_perlio_import)
 {
  dXSARGS;
  GV *gv = CvGV(cv);
@@ -241,7 +221,7 @@ XS(XS_io_import)
  XSRETURN_EMPTY;
 }
 
-XS(XS_io_unimport)
+XS(XS_perlio_unimport)
 {
  dXSARGS;
  GV *gv = CvGV(cv);
@@ -271,7 +251,7 @@ perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
 {
  if (SvROK(sv))
   {
-   IO *io = GvIOn(SvRV(sv));
+   IO *io = GvIOn((GV *)SvRV(sv));
    PerlIO *ifp = IoIFP(io);
    PerlIO *ofp = IoOFP(io);
    AV *av = (AV *) mg->mg_obj;
@@ -285,7 +265,7 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
 {
  if (SvROK(sv))
   {
-   IO *io = GvIOn(SvRV(sv));
+   IO *io = GvIOn((GV *)SvRV(sv));
    PerlIO *ifp = IoIFP(io);
    PerlIO *ofp = IoOFP(io);
    AV *av = (AV *) mg->mg_obj;
@@ -353,7 +333,7 @@ void
 PerlIO_define_layer(PerlIO_funcs *tab)
 {
  dTHX;
- HV *stash = gv_stashpv("io::Layer", TRUE);
+ HV *stash = gv_stashpv("perlio::Layer", TRUE);
  SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
  hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
 }
@@ -369,11 +349,13 @@ PerlIO_default_layer(I32 n)
  if (!PerlIO_layer_hv)
   {
    char *s  = PerlEnv_getenv("PERLIO");
-   newXS("io::import",XS_io_import,__FILE__);
-   newXS("io::unimport",XS_io_unimport,__FILE__);
+   newXS("perlio::import",XS_perlio_import,__FILE__);
+   newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
+#if 0
    newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
-   PerlIO_layer_hv = get_hv("io::layers",GV_ADD|GV_ADDMULTI);
-   PerlIO_layer_av = get_av("io::layers",GV_ADD|GV_ADDMULTI);
+#endif
+   PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
+   PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
    PerlIO_define_layer(&PerlIO_unix);
    PerlIO_define_layer(&PerlIO_perlio);
    PerlIO_define_layer(&PerlIO_stdio);
@@ -465,6 +447,30 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
  return f;
 }
 
+/*--------------------------------------------------------------------------------------*/
+/* Given the abstraction above the public API functions */
+
+#undef PerlIO_close
+int
+PerlIO_close(PerlIO *f)
+{
+ int code = (*PerlIOBase(f)->tab->Close)(f);
+ while (*f)
+  {
+   PerlIO_pop(f);
+  }
+ return code;
+}
+
+#undef PerlIO_fileno
+int
+PerlIO_fileno(PerlIO *f)
+{
+ return (*PerlIOBase(f)->tab->Fileno)(f);
+}
+
+
+
 #undef PerlIO_fdopen
 PerlIO *
 PerlIO_fdopen(int fd, const char *mode)