perlcc.PL cleanups

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

diff --git a/pp_sys.c b/pp_sys.c
index 7a9dc39..37b8d14 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -35,11 +35,6 @@
 #   include <shadow.h>
 #endif
 
-/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
-#ifdef I_UNISTD
-# include <unistd.h>
-#endif
-
 #ifdef HAS_SYSCALL
 #ifdef __cplusplus
 extern "C" int syscall(unsigned long,...);
@@ -54,33 +49,10 @@ extern "C" int syscall(unsigned long,...);
 # include <sys/resource.h>
 #endif
 
-#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
-# include <sys/socket.h>
-# if defined(USE_SOCKS) && defined(I_SOCKS)
-#   if !defined(INCLUDE_PROTOTYPES)
-#       define INCLUDE_PROTOTYPES /* for <socks.h> */
-#       define PERL_SOCKS_NEED_PROTOTYPES
-#   endif
-#   include <socks.h>
-#   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
-#       undef INCLUDE_PROTOTYPES
-#       undef PERL_SOCKS_NEED_PROTOTYPES
-#   endif 
-# endif
-# ifdef I_NETDB
-#  include <netdb.h>
-# endif
-# ifndef ENOTSOCK
-#  ifdef I_NET_ERRNO
-#   include <net/errno.h>
-#  endif
-# endif
-#endif
-
 #ifdef HAS_SELECT
-#ifdef I_SYS_SELECT
-#include <sys/select.h>
-#endif
+# ifdef I_SYS_SELECT
+#  include <sys/select.h>
+# endif
 #endif
 
 /* XXX Configure test needed.
@@ -325,6 +297,13 @@ PP(pp_backtick)
        mode = "rt";
     fp = PerlProc_popen(tmps, mode);
     if (fp) {
+       char *type = NULL;
+       if (PL_curcop->cop_io) {
+           type = SvPV_nolen(PL_curcop->cop_io);
+       }
+       if (type && *type)
+           PerlIO_apply_layers(aTHX_ fp,mode,type);
+
        if (gimme == G_VOID) {
            char tmpbuf[256];
            while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
@@ -705,11 +684,14 @@ PP(pp_binmode)
     PerlIO *fp;
     MAGIC *mg;
     SV *discp = Nullsv;
+    STRLEN len  = 0;
+    char *names = NULL;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
-    if (MAXARG > 1)
+    if (MAXARG > 1) {
        discp = POPs;
+    }
 
     gv = (GV*)POPs;
 
@@ -730,7 +712,12 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
 
-    if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp)))
+    if (discp) {
+       names = SvPV(discp,len);
+    }
+
+    if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
+                       (discp) ? SvPV_nolen(discp) : Nullch))
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -2557,9 +2544,15 @@ PP(pp_stat)
 
     if (PL_op->op_flags & OPf_REF) {
        gv = cGVOP_gv;
-       if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO) && gv != PL_defgv)
-           Perl_warner(aTHX_ WARN_IO,
+       if (PL_op->op_type == OP_LSTAT) {
+           if (PL_laststype != OP_LSTAT)
+               Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
+           if (ckWARN(WARN_IO) && gv != PL_defgv)
+               Perl_warner(aTHX_ WARN_IO,
                        "lstat() on filehandle %s", GvENAME(gv));
+               /* Perl_my_lstat (-l) croak's on filehandle, why warn here? */
+       }
+
       do_fstat:
        if (gv != PL_defgv) {
            PL_laststype = OP_STAT;
@@ -3149,7 +3142,7 @@ PP(pp_fttext)
            (void)PerlIO_close(fp);
            RETPUSHUNDEF;
        }
-       do_binmode(fp, '<', O_BINARY);
+       PerlIO_binmode(aTHX_ fp, '<', O_BINARY, Nullch);
        len = PerlIO_read(fp, tbuf, sizeof(tbuf));
        (void)PerlIO_close(fp);
        if (len <= 0) {