WinCE more implemented functions

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

diff --git a/pp_sys.c b/pp_sys.c
index c1ff341..b240b62 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -742,6 +742,14 @@ PP(pp_binmode)
     PUTBACK;
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
                        (discp) ? SvPV_nolen(discp) : Nullch)) {
+       if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+            if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
+                       mode_from_discipline(discp),
+                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+               SPAGAIN;
+               RETPUSHUNDEF;
+            }
+       }
        SPAGAIN;
        RETPUSHYES;
     }
@@ -875,8 +883,8 @@ PP(pp_untie)
                       (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
-       sv_unmagic(sv, how) ;
     }
+    sv_unmagic(sv, how) ;
     RETPUSHYES;
 }
 
@@ -1527,7 +1535,6 @@ PP(pp_sysread)
     bool charstart = FALSE;
     STRLEN charskip = 0;
     STRLEN skip = 0;
-    PerlIO *pio;
 
     gv = (GV*)*++MARK;
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
@@ -1566,19 +1573,7 @@ PP(pp_sysread)
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }
-    pio = IoIFP(io);
-#ifdef PERLIO_LAYERS
-    if (PL_op->op_type == OP_SYSREAD) {
-       /* sysread happens further down the stack
-          and we need isutf8 of that layer
-        */
-       pio = PerlIO_syslayer(aTHX_ pio);
-       if (!pio) {
-           goto say_undef;
-       }
-    }
-#endif
-    if ((fp_utf8 = PerlIO_isutf8(pio)) && !IN_BYTES) {
+    if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);
@@ -1608,7 +1603,7 @@ PP(pp_sysread)
 #endif
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */
-       count = PerlSock_recvfrom(PerlIO_fileno(pio), buffer, length, offset,
+       count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
                          (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
@@ -1655,22 +1650,20 @@ PP(pp_sysread)
     }
     buffer = buffer + offset;
 
-#ifndef PERLIO_LAYERS
     if (PL_op->op_type == OP_SYSREAD) {
 #ifdef PERL_SOCK_SYSREAD_IS_RECV
        if (IoTYPE(io) == IoTYPE_SOCKET) {
-           count = PerlSock_recv(PerlIO_fileno(pio),
+           count = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
                                   buffer, length, 0);
        }
        else
 #endif
        {
-           count = PerlLIO_read(PerlIO_fileno(pio),
+           count = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
                                  buffer, length);
        }
     }
     else
-#endif
 #ifdef HAS_SOCKET__bad_code_maybe
     if (IoTYPE(io) == IoTYPE_SOCKET) {
        char namebuf[MAXPATHLEN];
@@ -1679,15 +1672,15 @@ PP(pp_sysread)
 #else
        bufsize = sizeof namebuf;
 #endif
-       count = PerlSock_recvfrom(PerlIO_fileno(pio), buffer, length, 0,
+       count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, 0,
                          (struct sockaddr *)namebuf, &bufsize);
     }
     else
 #endif
     {
-       count = PerlIO_read(pio, buffer, length);
+       count = PerlIO_read(IoIFP(io), buffer, length);
        /* PerlIO_read() - like fread() returns 0 on both error and EOF */
-       if (count == 0 && PerlIO_error(pio))
+       if (count == 0 && PerlIO_error(IoIFP(io)))
            count = -1;
     }
     if (count < 0) {
@@ -2494,8 +2487,12 @@ PP(pp_accept)
     GV *ggv;
     register IO *nstio;
     register IO *gstio;
-    struct sockaddr saddr;     /* use a struct to avoid alignment problems */
-    Sock_size_t len = sizeof saddr;
+    char namebuf[MAXPATHLEN];
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+    Sock_size_t len = sizeof (struct sockaddr_in);
+#else
+    Sock_size_t len = sizeof namebuf;
+#endif
     int fd;
 
     ggv = (GV*)POPs;
@@ -2511,7 +2508,7 @@ PP(pp_accept)
        goto nuts;
 
     nstio = GvIOn(ngv);
-    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
     if (fd < 0)
        goto badexit;
     if (IoIFP(nstio))
@@ -2530,14 +2527,14 @@ PP(pp_accept)
 #endif
 
 #ifdef EPOC
-    len = sizeof saddr;          /* EPOC somehow truncates info */
+    len = sizeof (struct sockaddr_in); /* EPOC somehow truncates info */
     setbuf( IoIFP(nstio), NULL); /* EPOC gets confused about sockets */
 #endif
 #ifdef __SCO_VERSION__
-    len = sizeof saddr;          /* OpenUNIX 8 somehow truncates info */
+    len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
 #endif
 
-    PUSHp((char *)&saddr, len);
+    PUSHp(namebuf, len);
     RETURN;
 
 nuts:
@@ -3340,7 +3337,7 @@ PP(pp_fttext)
        PL_laststype = OP_STAT;
        sv_setpv(PL_statname, SvPV(sv, n_a));
        if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
+           if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
            RETPUSHUNDEF;
        }
@@ -4159,14 +4156,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
-#  ifdef WIN32
+#  if defined(WIN32) || defined(OS2)
        value = (I32)do_aspawn(really, MARK, SP);
 #  else
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
-#  ifdef WIN32
+#  if defined(WIN32) || defined(OS2)
        value = (I32)do_aspawn(Nullsv, MARK, SP);
 #  else
        value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);