Ooops, wrong 'no *POSIX' Patch

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 7d95735..c8047f8 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -553,7 +553,8 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN
    l->next = *f;
    l->tab  = tab;
    *f      = l;
-   PerlIO_debug("PerlIO_push f=%p %s %s\n",f,tab->name,(mode) ? mode : "(Null)");
+   PerlIO_debug("PerlIO_push f=%p %s %s '%.*s'\n",
+                 f,tab->name,(mode) ? mode : "(Null)",(int) len,arg);
    if ((*l->tab->Pushed)(f,mode,arg,len) != 0)
     {
      PerlIO_pop(f);
@@ -620,56 +621,73 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
       s++;
      if (*s)
       {
+       STRLEN llen = 0;
        const char *e = s;
        const char *as = Nullch;
-       const char *ae = Nullch;
-       int count = 0;
-       while (*e && *e != ':' && !isSPACE(*e))
+       STRLEN alen = 0;
+       if (!isIDFIRST(*s))
         {
-         if (*e == '(')
-          {
-           if (!as)
-            as = e;
-           count++;
-          }
-         else if (*e == ')')
+         /* Message is consistent with how attribute lists are passed.
+            Even though this means "foo : : bar" is seen as an invalid separator
+            character.  */
+         char q = ((*s == '\'') ? '"' : '\'');
+         Perl_warn(aTHX_ "perlio: invalid separator character %c%c%c in layer specification list", q, *s, q);
+         return -1;
+        }
+       do
+        {
+         e++;
+        } while (isALNUM(*e));
+       llen = e-s;
+       if (*e == '(')
+        {
+         int nesting = 1;
+         as = ++e;
+         while (nesting)
           {
-           if (as && --count == 0)
-            ae = e;
+           switch (*e++)
+            {
+             case ')':
+              if (--nesting == 0)
+               alen = (e-1)-as;
+              break;
+             case '(':
+              ++nesting;
+              break;
+             case '\\':
+              /* It's a nul terminated string, not allowed to \ the terminating null.
+                 Anything other character is passed over.  */
+              if (*e++)
+               {
+                break;
+               }
+              /* Drop through */
+             case '\0':
+              e--;
+              Perl_warn(aTHX_ "perlio: argument list not closed for layer \"%.*s\"",(int)(e - s),s);
+              return -1;
+             default:
+              /* boring.  */
+              break;
+            }
           }
-         e++;
         }
        if (e > s)
         {
-         if ((e - s) == 4 && strncmp(s,"utf8",4) == 0)
-          {
-           PerlIOBase(f)->flags |= PERLIO_F_UTF8;
-          }
-         else if ((e - s) == 5 && strncmp(s,"bytes",5) == 0)
-          {
-           PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
-          }
-         else
+         SV *layer = PerlIO_find_layer(s,llen);
+         if (layer)
           {
-           STRLEN len = ((as) ? as : e)-s;
-           SV *layer = PerlIO_find_layer(s,len);
-           if (layer)
+           PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
+           if (tab)
             {
-             PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
-             if (tab)
-              {
-              if (as && (ae == Nullch)) {
-               ae = e;
-               Perl_warn(aTHX_ "perlio: argument list not closed for layer \"%.*s\"",(int)(e - s),s);
-              }
-               len = (as) ? (ae-(as++)-1) : 0;
-               if (!PerlIO_push(f,tab,mode,as,len))
-                return -1;
-              }
+             if (!PerlIO_push(f,tab,mode,as,alen))
+              return -1;
             }
-           else
-            Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)len,s);
           }
+         else {
+          Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)llen,s);
+         return -1;
+        }
         }
        s = e;
       }
@@ -1680,6 +1698,7 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
 IV
 PerlIOStdio_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
 {
+ dTHX;
  if (*PerlIONext(f))
   {
    PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
@@ -1806,12 +1825,12 @@ IV
 PerlIOStdio_close(PerlIO *f)
 {
  dTHX;
-#ifdef HAS_SOCKET
+#ifdef HAS_SOCKS5_INIT
  int optval, optlen = sizeof(int);
 #endif
  FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
  return(
-#ifdef HAS_SOCKET
+#ifdef HAS_SOCKS5_INIT
    (getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (char *)&optval, &optlen) < 0) ?
        PerlSIO_fclose(stdio) :
        close(PerlIO_fileno(f))