This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Snapshot of new PerlIO open scheme. Still buggy - mainly in open($fh,">&STDOUT!")
authorNick Ing-Simmons <nik@tiuk.ti.com>
Thu, 22 Mar 2001 22:26:51 +0000 (22:26 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Thu, 22 Mar 2001 22:26:51 +0000 (22:26 +0000)
type code.
  - Invent PerlIO_openn() - which has "lots" of args a bit like do_openn() which
    is its main caller. In particular now has access to "extra" args, and
    can tell when an open handle is "reopened" (or duped?).
  - In -Duseperlio PerlIO_open() et. al. are now wrappers on PerlIO_openn().
  - In -Uuseperlio (untested as yet) PerlIO_openn() is a wrapper on
    PerlIO_open() et. al. (i.e. other way round).
  - Collapse "vtable" entries for layers - was fdopen/open/reopen now just open
    with args close to PerlIO_openn().

p4raw-id: //depot/perlio@9302

doio.c
ext/Encode/Encode.xs
perlio.c
perlio.h
perliol.h

diff --git a/doio.c b/doio.c
index a32604e..3a4bbe7 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -68,6 +68,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    supplied_fp, &svs, 1);
 }
 
+static char *S_layers(pTHX_ char *mode);
+
+static char *
+S_layers(pTHX_ char *mode)
+{
+    char *type = NULL;
+     /* Need to supply default layer info from open.pm */
+    SV *layers = PL_curcop->cop_io;
+    if (layers) {
+        STRLEN len;
+        type = SvPV(layers,len);
+        if (type && mode[0] != 'r') {
+           /* Skip to write part */
+           char *s = strchr(type,0);
+           if (s && (s-type) < len) {
+               type = s+1;
+           }
+        }
+    }
+   return type;
+}
+
 bool
 Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
@@ -76,6 +98,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
+    int savefd = -1;
     char savetype = IoTYPE_CLOSED;
     int writing = 0;
     PerlIO *fp;
@@ -84,8 +107,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
     char *type  = NULL;
-    char mode[4];              /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
-    SV *svs = (num_svs) ? *svp : Nullsv;
+    char mode[8];              /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    SV *namesv;
 
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;                /* assume true if no fork */
@@ -103,13 +126,17 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     /* If currently open - close before we re-open */
     if (IoIFP(io)) {
        fd = PerlIO_fileno(IoIFP(io));
-       if (IoTYPE(io) == IoTYPE_STD)
+       if (IoTYPE(io) == IoTYPE_STD) {
+           /* This is a clone of one of STD* handles */
            result = 0;
-       else if (fd <= PL_maxsysfd) {
-           saveifp = IoIFP(io);
-           saveofp = IoOFP(io);
+       }
+       else if (fd >= 0 && fd <= PL_maxsysfd) {
+           /* This is one of the original STD* handles */
+           saveifp  = IoIFP(io);
+           saveofp  = IoOFP(io);
            savetype = IoTYPE(io);
-           result = 0;
+           savefd   = fd;
+           result   = 0;
        }
        else if (IoTYPE(io) == IoTYPE_PIPE)
            result = PerlProc_pclose(IoIFP(io));
@@ -123,18 +150,22 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
        else
            result = PerlIO_close(IoIFP(io));
-       if (result == EOF && fd > PL_maxsysfd)
+       if (result == EOF && fd > PL_maxsysfd) {
+           /* Why is this not Perl_warn*() call ? */
            PerlIO_printf(Perl_error_log,
                          "Warning: unable to close filehandle %s properly.\n",
                          GvENAME(gv));
+       }
        IoOFP(io) = IoIFP(io) = Nullfp;
     }
 
     if (as_raw) {
         /* sysopen style args, i.e. integer mode and permissions */
+       STRLEN ix = 0;
        if (num_svs != 0) {
             Perl_croak(aTHX_ "panic:sysopen with multiple args");
        }
+       mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
        rawmode |= O_LARGEFILE;
@@ -156,39 +187,34 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             IoTYPE(io) = IoTYPE_RDWR;
             break;
        }
-
        writing = (result > 0);
-       fd = PerlLIO_open3(name, rawmode, rawperm);
 
-       if (fd == -1)
-           fp = NULL;
-       else {
-           STRLEN ix = 0;
-           if (result == O_RDONLY) {
-               mode[ix++] = 'r';
-           }
+       if (result == O_RDONLY) {
+           mode[ix++] = 'r';
+       }
 #ifdef O_APPEND
-           else if (rawmode & O_APPEND) {
-               mode[ix++] = 'a';
-               if (result != O_WRONLY)
-                   mode[ix++] = '+';
-           }
+       else if (rawmode & O_APPEND) {
+           mode[ix++] = 'a';
+           if (result != O_WRONLY)
+               mode[ix++] = '+';
+       }
 #endif
+       else {
+           if (result == O_WRONLY)
+               mode[ix++] = 'w';
            else {
-               if (result == O_WRONLY)
-                   mode[ix++] = 'w';
-               else {
-                   mode[ix++] = 'r';
-                   mode[ix++] = '+';
-               }
+               mode[ix++] = 'r';
+               mode[ix++] = '+';
            }
-           if (rawmode & O_BINARY)
-               mode[ix++] = 'b';
-           mode[ix] = '\0';
-           fp = PerlIO_fdopen(fd, mode);
-           if (!fp)
-               PerlLIO_close(fd);
        }
+       if (rawmode & O_BINARY)
+           mode[ix++] = 'b';
+       mode[ix] = '\0';
+
+       namesv = sv_2mortal(newSVpvn(name,strlen(name)));
+       num_svs = 1;
+       svp = &namesv;
+       fp = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode, -1, rawmode, rawperm, saveifp, num_svs, svp);
     }
     else {
        /* Regular (non-sys) open */
@@ -206,7 +232,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l;
-           name = SvPV(svs, l) ;
+           name = SvPV(*svp, l) ;
            len = (I32)l;
            name = savepvn(name, len);
            SAVEFREEPV(name);
@@ -273,8 +299,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                mode[0] = IoTYPE(io) = IoTYPE_APPEND;
                type++;
            }
-           else
+           else {
                mode[0] = 'w';
+           }
            writing = 1;
 
            if (out_raw)
@@ -290,15 +317,17 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    dodup = 0;
                    type++;
                }
-               if (!num_svs && !*type && supplied_fp)
+               if (!num_svs && !*type && supplied_fp) {
                    /* "<+&" etc. is used by typemaps */
                    fp = supplied_fp;
+               }
                else {
                    if (num_svs > 1) {
                        Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
                    }
-                   if (num_svs && SvIOK(*svp))
+                   if (num_svs && SvIOK(*svp)) {
                        fd = SvUV(*svp);
+                   }
                    else if (isDIGIT(*type)) {
                        /*SUPPRESS 530*/
                        for (; isSPACE(*type); type++) ;
@@ -361,12 +390,14 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        fd = PerlLIO_dup(fd);
                    else
                        was_fdopen = TRUE;
-                   if (!(fp = PerlIO_fdopen(fd,mode))) {
+                   if (!num_svs)
+                       type = S_layers(aTHX_ mode);
+                   if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
                        if (dodup)
                            PerlLIO_close(fd);
                    }
                }
-           }
+           } /* & */
            else {
                if (num_svs > 1) {
                    Perl_croak(aTHX_ "More than one argument to '>' open");
@@ -380,9 +411,15 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    IoTYPE(io) = IoTYPE_STD;
                }
                else  {
-                   fp = PerlIO_open((num_svs ? name : type), mode);
+                   if (!num_svs) {
+                       namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+                       num_svs = 1;
+                       svp = &namesv;
+                       type = S_layers(aTHX_ mode);
+                   }
+                   fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
                }
-           }
+           } /* !& */
        }
        else if (*type == IoTYPE_RDONLY) {
            if (num_svs > 1) {
@@ -405,8 +442,15 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                fp = PerlIO_stdin();
                IoTYPE(io) = IoTYPE_STD;
            }
-           else
-               fp = PerlIO_open((num_svs ? name : type), mode);
+           else {
+               if (!num_svs) {
+                   namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+                   num_svs = 1;
+                   svp = &namesv;
+                   type = S_layers(aTHX_ mode);
+               }
+               fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
+           }
        }
        else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) ||
                 (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) {
@@ -462,7 +506,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                IoTYPE(io) = IoTYPE_STD;
            }
            else {
-               fp = PerlIO_open(name,mode);
+               if (!num_svs) {
+                   namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+                   num_svs = 1;
+                   svp = &namesv;
+                   type = S_layers(aTHX_ mode);
+               }
+               fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
            }
        }
     }
@@ -478,7 +528,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
                                (fp == PerlIO_stdout()) ? "out" : "err");
        }
-       else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdout()) {
+       else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
                Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
        }
     }
@@ -514,17 +564,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
         /* If fd is less that PL_maxsysfd i.e. STDIN..STDERR
            then dup the new fileno down
          */
-       fd = PerlIO_fileno(saveifp);
        if (saveofp) {
            PerlIO_flush(saveofp);      /* emulate PerlIO_close() */
            if (saveofp != saveifp) {   /* was a socket? */
                PerlIO_close(saveofp);
-                /* This looks very suspect - NI-S 24 Nov 2000 */
-               if (fd > 2)
-                   Safefree(saveofp);  /* ??? */
            }
        }
-       if (fd != PerlIO_fileno(fp)) {
+       if (savefd != PerlIO_fileno(fp)) {
            Pid_t pid;
            SV *sv;
 
@@ -549,7 +595,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            SvIVX(sv) = pid;
            if (!was_fdopen)
                PerlIO_close(fp);
-
        }
        fp = saveifp;
        PerlIO_clearerr(fp);
@@ -563,52 +608,17 @@ Perl_do_openn(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 */
-       SV *layers = PL_curcop->cop_io;
-       type = NULL;
-       if (layers) {
-           STRLEN len;
-           type = SvPV(layers,len);
-           if (type && mode[0] != 'r') {
-               /* Skip to write part */
-               char *s = strchr(type,0);
-               if (s && (s-type) < len) {
-                   type = s+1;
-               }
-           }
-       }
-    }
-    if (type) {
-       while (isSPACE(*type)) type++;
-       if (*type) {
-          errno = 0;
-          if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
-               goto say_false;
-          }
-       }
-    }
 
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
        if (IoTYPE(io) == IoTYPE_SOCKET
-           || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
-       {
+           || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) {
            mode[0] = 'w';
-           if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) {
+           if (!(IoOFP(io) = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode,PerlIO_fileno(fp),0,0,saveofp,num_svs,svp))) {
                PerlIO_close(fp);
                IoIFP(io) = Nullfp;
                goto say_false;
            }
-           if (type && *type) {
-               if (PerlIO_apply_layers(aTHX_ IoOFP(io),mode,type) != 0) {
-                   PerlIO_close(IoOFP(io));
-                   PerlIO_close(fp);
-                   IoIFP(io) = Nullfp;
-                   IoOFP(io) = Nullfp;
-                   goto say_false;
-               }
-           }
        }
        else
            IoOFP(io) = fp;
index 4d62501..5d33303 100644 (file)
@@ -301,9 +301,7 @@ PerlIO_funcs PerlIO_encode = {
  sizeof(PerlIOEncode),
  PERLIO_K_BUFFERED,
  PerlIOBase_fileno,
- PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBuf_reopen,
  PerlIOEncode_pushed,
  PerlIOEncode_popped,
  PerlIOBuf_read,
index 132fe47..d192892 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -99,6 +99,36 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
  return perlsio_binmode(fp,iotype,mode);
 }
 
+/* De-mux PerlIO_openn() into fdopen, freopen and fopen type entries */
+
+PerlIO *
+PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
+{
+ if (narg == 1)
+  {
+   char *name = SvPV_nolen(*args);
+   if (*mode == '#')
+    {
+     fd = PerlLIO_open3(name,imode,perm);
+     if (fd >= 0)
+      return PerlIO_fdopen(fd,mode+1);
+    }
+   else if (old)
+    {
+     return PerlIO_reopen(name,mode,old);
+    }
+   else
+    {
+     return PerlIO_open(name,mode);
+    }
+  }
+ else
+  {
+   return PerlIO_fdopen(fd,mode);
+  }
+ return NULL;
+}
+
 #endif
 
 
@@ -765,44 +795,47 @@ PerlIO_fileno(PerlIO *f)
  return (*PerlIOBase(f)->tab->Fileno)(f);
 }
 
+PerlIO_funcs *
+PerlIO_top_layer(pTHX_ const char *layers)
+{
+ /* FIXME !!! */
+ return PerlIO_default_top();
+}
+
+PerlIO *
+PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
+{
+ PerlIO_funcs *tab = (f && *f) ? PerlIOBase(f)->tab : PerlIO_top_layer(aTHX_ layers);
+ if (!_perlio)
+  PerlIO_stdstreams();
+ return (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,f,narg,args);
+}
 
 
 #undef PerlIO_fdopen
 PerlIO *
 PerlIO_fdopen(int fd, const char *mode)
 {
- PerlIO_funcs *tab = PerlIO_default_top();
- if (!_perlio)
-  PerlIO_stdstreams();
- return (*tab->Fdopen)(tab,fd,mode);
+ dTHX;
+ return PerlIO_openn(aTHX_ Nullch,mode,fd,0,0,NULL,0,NULL);
 }
 
 #undef PerlIO_open
 PerlIO *
 PerlIO_open(const char *path, const char *mode)
 {
- PerlIO_funcs *tab = PerlIO_default_top();
- if (!_perlio)
-  PerlIO_stdstreams();
- return (*tab->Open)(tab,path,mode);
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path,strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch,mode,-1,0,0,NULL,1,&name);
 }
 
 #undef PerlIO_reopen
 PerlIO *
 PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
 {
- if (f)
-  {
-   PerlIO_flush(f);
-   if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
-    {
-     if ((*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) == 0)
-      return f;
-    }
-   return NULL;
-  }
- else
-  return PerlIO_open(path,mode);
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path,strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch,mode,-1,0,0,f,1,&name);
 }
 
 #undef PerlIO_read
@@ -1041,10 +1074,10 @@ PerlIOUtf8_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
 }
 
 PerlIO *
-PerlIOUtf8_fdopen(PerlIO_funcs *self, int fd,const char *mode)
+PerlIOUtf8_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
 {
  PerlIO_funcs *tab = PerlIO_default_layer(-2);
- PerlIO *f = (*tab->Fdopen)(tab,fd,mode);
+ PerlIO *f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args);
  if (f)
   {
    PerlIOl *l = PerlIOBase(f);
@@ -1056,30 +1089,12 @@ PerlIOUtf8_fdopen(PerlIO_funcs *self, int fd,const char *mode)
  return f;
 }
 
-PerlIO *
-PerlIOUtf8_open(PerlIO_funcs *self, const char *path,const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_layer(-2);
- PerlIO *f = (*tab->Open)(tab,path,mode);
- if (f)
-  {
-   PerlIOl *l = PerlIOBase(f);
-   if (tab->kind & PERLIO_K_UTF8)
-    l->flags |= PERLIO_F_UTF8;
-   else
-    l->flags &= ~PERLIO_F_UTF8;
-  }
- return f;
-}
-
 PerlIO_funcs PerlIO_utf8 = {
  "utf8",
  sizeof(PerlIOl),
  PERLIO_K_DUMMY|PERLIO_F_UTF8,
  NULL,
- PerlIOUtf8_fdopen,
  PerlIOUtf8_open,
- NULL,
  PerlIOUtf8_pushed,
  NULL,
  NULL,
@@ -1106,9 +1121,7 @@ PerlIO_funcs PerlIO_byte = {
  sizeof(PerlIOl),
  PERLIO_K_DUMMY,
  NULL,
- PerlIOUtf8_fdopen,
  PerlIOUtf8_open,
- NULL,
  PerlIOUtf8_pushed,
  NULL,
  NULL,
@@ -1131,17 +1144,10 @@ PerlIO_funcs PerlIO_byte = {
 };
 
 PerlIO *
-PerlIORaw_fdopen(PerlIO_funcs *self, int fd,const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_btm();
- return (*tab->Fdopen)(tab,fd,mode);
-}
-
-PerlIO *
-PerlIORaw_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIORaw_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
 {
  PerlIO_funcs *tab = PerlIO_default_btm();
- return (*tab->Open)(tab,path,mode);
+ return (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args);
 }
 
 PerlIO_funcs PerlIO_raw = {
@@ -1149,9 +1155,7 @@ PerlIO_funcs PerlIO_raw = {
  sizeof(PerlIOl),
  PERLIO_K_DUMMY,
  NULL,
- PerlIORaw_fdopen,
  PerlIORaw_open,
- NULL,
  PerlIORaw_pushed,
  PerlIOBase_popped,
  NULL,
@@ -1470,45 +1474,53 @@ PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
 }
 
 PerlIO *
-PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIOUnix_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
 {
- dTHX;
- PerlIO *f = NULL;
- int oflags = PerlIOUnix_oflags(mode);
- if (oflags != -1)
+ if (f)
   {
-   int fd = PerlLIO_open3(path,oflags,0666);
-   if (fd >= 0)
+   if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
+    (*PerlIOBase(f)->tab->Close)(f);
+  }
+ if (narg > 0)
+  {
+   char *path = SvPV_nolen(*args);
+   if (*mode == '#')
+    mode++;
+   else
     {
-     PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
-     s->fd     = fd;
-     s->oflags = oflags;
-     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+     imode = PerlIOUnix_oflags(mode);
+     perm  = 0666;
+    }
+   if (imode != -1)
+    {
+     fd = PerlLIO_open3(path,imode,perm);
     }
   }
- return f;
-}
-
-int
-PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f)
-{
- PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix);
- int oflags = PerlIOUnix_oflags(mode);
- if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
-  (*PerlIOBase(f)->tab->Close)(f);
- if (oflags != -1)
+ if (fd >= 0)
   {
-   dTHX;
-   int fd = PerlLIO_open3(path,oflags,0666);
-   if (fd >= 0)
+   PerlIOUnix *s;
+   if (*mode == 'I')
+    mode++;
+   if (!f)
     {
-     s->fd = fd;
-     s->oflags = oflags;
-     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-     return 0;
+     f = PerlIO_allocate(aTHX);
+     s = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOUnix);
     }
+   else
+    s = PerlIOSelf(f,PerlIOUnix);
+   s->fd     = fd;
+   s->oflags = imode;
+   PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+   return f;
+  }
+ else
+  {
+   if (f)
+    {
+     /* FIXME: pop layers ??? */
+    }
+   return NULL;
   }
- return -1;
 }
 
 SSize_t
@@ -1595,9 +1607,7 @@ PerlIO_funcs PerlIO_unix = {
  sizeof(PerlIOUnix),
  PERLIO_K_RAW,
  PerlIOUnix_fileno,
- PerlIOUnix_fdopen,
  PerlIOUnix_open,
- PerlIOUnix_reopen,
  PerlIOUnix_pushed,
  PerlIOBase_noop_ok,
  PerlIOUnix_read,
@@ -1658,40 +1668,6 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
  PerlIO *f = NULL;
  int init = 0;
  char tmode[8];
- if (*mode == 'I')
-  {
-   init = 1;
-   mode++;
-  }
- if (fd >= 0)
-  {
-   FILE *stdio = NULL;
-   if (init)
-    {
-     switch(fd)
-      {
-       case 0:
-        stdio = PerlSIO_stdin;
-        break;
-       case 1:
-        stdio = PerlSIO_stdout;
-        break;
-       case 2:
-        stdio = PerlSIO_stderr;
-        break;
-      }
-    }
-   else
-    {
-     stdio = PerlSIO_fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
-    }
-   if (stdio)
-    {
-     PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
-     s->stdio  = stdio;
-    }
-  }
- return f;
 }
 
 /* This isn't used yet ... */
@@ -1727,33 +1703,79 @@ PerlIO_importFILE(FILE *stdio, int fl)
 }
 
 PerlIO *
-PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIOStdio_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
 {
- dTHX;
- PerlIO *f = NULL;
- FILE *stdio = PerlSIO_fopen(path,mode);
- if (stdio)
+ char tmode[8];
+ if (f)
   {
-   char tmode[8];
-   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
-                               (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
-                               PerlIOStdio);
-   s->stdio  = stdio;
+   char *path = SvPV_nolen(*args);
+   PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
+   FILE *stdio = PerlSIO_freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
+   if (!s->stdio)
+    return NULL;
+   s->stdio = stdio;
+   return f;
   }
- return f;
-}
-
-int
-PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f)
-{
- dTHX;
- PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
- char tmode[8];
- FILE *stdio = PerlSIO_freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
- if (!s->stdio)
-  return -1;
- s->stdio = stdio;
- return 0;
+ else
+  {
+   if (narg > 0)
+    {
+     char *path = SvPV_nolen(*args);
+     if (*mode == '#')
+      {
+       mode++;
+       fd = PerlLIO_open3(path,imode,perm);
+      }
+     else
+      {
+       FILE *stdio = PerlSIO_fopen(path,mode);
+       if (stdio)
+        {
+         PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
+                                     (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
+                                     PerlIOStdio);
+         s->stdio  = stdio;
+        }
+       return f;
+      }
+    }
+   if (fd >= 0)
+    {
+     FILE *stdio = NULL;
+     int init = 0;
+     if (*mode == 'I')
+      {
+       init = 1;
+       mode++;
+      }
+     if (init)
+      {
+       switch(fd)
+        {
+         case 0:
+          stdio = PerlSIO_stdin;
+          break;
+         case 1:
+          stdio = PerlSIO_stdout;
+          break;
+         case 2:
+          stdio = PerlSIO_stderr;
+          break;
+        }
+      }
+     else
+      {
+       stdio = PerlSIO_fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
+      }
+     if (stdio)
+      {
+       PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
+       s->stdio  = stdio;
+       return f;
+      }
+    }
+  }
+ return NULL;
 }
 
 SSize_t
@@ -1995,9 +2017,7 @@ PerlIO_funcs PerlIO_stdio = {
  sizeof(PerlIOStdio),
  PERLIO_K_BUFFERED,
  PerlIOStdio_fileno,
- PerlIOStdio_fdopen,
  PerlIOStdio_open,
- PerlIOStdio_reopen,
  PerlIOBase_pushed,
  PerlIOBase_noop_ok,
  PerlIOStdio_read,
@@ -2094,60 +2114,46 @@ PerlIOBuf_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
 }
 
 PerlIO *
-PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
+PerlIOBuf_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
 {
- dTHX;
- PerlIO_funcs *tab = PerlIO_default_btm();
- int init = 0;
- PerlIO *f;
- if (*mode == 'I')
-  {
-   init = 1;
-   mode++;
-  }
-#if O_BINARY != O_TEXT
- /* do something about failing setmode()? --jhi */
- PerlLIO_setmode(fd, O_BINARY);
-#endif
- f = (*tab->Fdopen)(tab,fd,mode);
  if (f)
   {
-   PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
-   if (init && fd == 2)
+   PerlIO *next = PerlIONext(f);
+   PerlIO_funcs *tab = PerlIOBase(next)->tab;
+   next = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,next,narg,args);
+   if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) != 0)
     {
-     /* Initial stderr is unbuffered */
-     PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+     return NULL;
     }
-#if 0
-   PerlIO_debug("PerlIOBuf_fdopen %s f=%p fd=%d m=%s fl=%08"UVxf"\n",
-                self->name,f,fd,mode,PerlIOBase(f)->flags);
-#endif
   }
- return f;
-}
-
-PerlIO *
-PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_btm();
- PerlIO *f = (*tab->Open)(tab,path,mode);
- if (f)
+ else
   {
-   PerlIO_push(f,self,mode,Nullch,0);
+   PerlIO_funcs *tab = PerlIO_default_btm();
+   int init = 0;
+   if (*mode == 'I')
+    {
+     init = 1;
+     mode++;
+    }
+   f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,NULL,narg,args);
+   if (f)
+    {
+     PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
+     fd = PerlIO_fileno(f);
+#if O_BINARY != O_TEXT
+     /* do something about failing setmode()? --jhi */
+     PerlLIO_setmode(fd , O_BINARY);
+#endif
+     if (init && fd == 2)
+      {
+       /* Initial stderr is unbuffered */
+       PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+      }
+    }
   }
  return f;
 }
 
-int
-PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
-{
- PerlIO *next = PerlIONext(f);
- int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
- if (code = 0)
-  code = (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0);
- return code;
-}
-
 /* This "flush" is akin to sfio's sync in that it handles files in either
    read or write state
 */
@@ -2518,9 +2524,7 @@ PerlIO_funcs PerlIO_perlio = {
  sizeof(PerlIOBuf),
  PERLIO_K_BUFFERED,
  PerlIOBase_fileno,
- PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBuf_reopen,
  PerlIOBuf_pushed,
  PerlIOBase_noop_ok,
  PerlIOBuf_read,
@@ -2636,8 +2640,6 @@ PerlIO_funcs PerlIO_pending = {
  PERLIO_K_BUFFERED,
  PerlIOBase_fileno,
  NULL,
- NULL,
- NULL,
  PerlIOPending_pushed,
  PerlIOBase_noop_ok,
  PerlIOPending_read,
@@ -2942,9 +2944,7 @@ PerlIO_funcs PerlIO_crlf = {
  sizeof(PerlIOCrlf),
  PERLIO_K_BUFFERED|PERLIO_K_CANCRLF,
  PerlIOBase_fileno,
- PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBuf_reopen,
  PerlIOCrlf_pushed,
  PerlIOBase_noop_ok,   /* popped */
  PerlIOBuf_read,       /* generic read works with ptr/cnt lies ... */
@@ -3248,9 +3248,7 @@ PerlIO_funcs PerlIO_mmap = {
  sizeof(PerlIOMmap),
  PERLIO_K_BUFFERED,
  PerlIOBase_fileno,
- PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBuf_reopen,
  PerlIOBuf_pushed,
  PerlIOBase_noop_ok,
  PerlIOBuf_read,
index b144b24..4efdae3 100644 (file)
--- a/perlio.h
+++ b/perlio.h
@@ -189,6 +189,9 @@ extern int  PerlIO_puts             (PerlIO *,const char *);
 #ifndef PerlIO_open
 extern PerlIO *        PerlIO_open             (const char *,const char *);
 #endif
+#ifndef PerlIO_open
+extern PerlIO *        PerlIO_openn            (pTHX_ const char *layers, const char *mode,int fd,int imode,int perm,PerlIO *old,int narg,SV **arg);
+#endif
 #ifndef PerlIO_close
 extern int     PerlIO_close            (PerlIO *);
 #endif
index 6d4485a..d97df31 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -7,9 +7,7 @@ struct _PerlIO_funcs
  Size_t                size;
  IV            kind;
  IV            (*Fileno)(PerlIO *f);
- PerlIO *      (*Fdopen)(PerlIO_funcs *tab, int fd, const char *mode);
- PerlIO *      (*Open)(PerlIO_funcs *tab, const char *path, const char *mode);
- int           (*Reopen)(const char *path, const char *mode, PerlIO *f);
+ PerlIO *      (*Open)(pTHX_ PerlIO_funcs *tab, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args);
  IV            (*Pushed)(PerlIO *f,const char *mode,const char *arg,STRLEN len);
  IV            (*Popped)(PerlIO *f);
  /* Unix-like functions - cf sfio line disciplines */
@@ -131,9 +129,7 @@ typedef struct
  IV            oneword;    /* Emergency buffer */
 } PerlIOBuf;
 
-extern PerlIO *        PerlIOBuf_fdopen     (PerlIO_funcs *self, int fd, const char *mode);
-extern PerlIO *        PerlIOBuf_open       (PerlIO_funcs *self, const char *path, const char *mode);
-extern int     PerlIOBuf_reopen     (const char *path, const char *mode, PerlIO *f);
+extern PerlIO *        PerlIOBuf_open       (pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args);
 extern SSize_t PerlIOBuf_read       (PerlIO *f, void *vbuf, Size_t count);
 extern SSize_t PerlIOBuf_unread     (PerlIO *f, const void *vbuf, Size_t count);
 extern SSize_t PerlIOBuf_write      (PerlIO *f, const void *vbuf, Size_t count);