integrate cfgperl contents into mainline
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index a529b25..90c1221 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -304,9 +304,14 @@ PP(pp_backtick)
     STRLEN n_a;
     char *tmps = POPpx;
     I32 gimme = GIMME_V;
+    char *mode = "r";
 
     TAINT_PROPER("``");
-    fp = PerlProc_popen(tmps, "r");
+    if (PL_op->op_private & OPpOPEN_IN_RAW)
+       mode = "rb";
+    else if (PL_op->op_private & OPpOPEN_IN_CRLF)
+       mode = "rt";
+    fp = PerlProc_popen(tmps, mode);
     if (fp) {
        if (gimme == G_VOID) {
            char tmpbuf[256];
@@ -687,15 +692,20 @@ PP(pp_binmode)
     IO *io;
     PerlIO *fp;
     MAGIC *mg;
+    SV *discp = Nullsv;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
+    if (MAXARG > 1)
+       discp = POPs;
 
     gv = (GV*)POPs; 
 
     if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
        PUSHMARK(SP);
        XPUSHs(SvTIED_obj((SV*)gv, mg));
+       if (discp)
+           XPUSHs(discp);
        PUTBACK;
        ENTER;
        call_method("BINMODE", G_SCALAR);
@@ -708,13 +718,12 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
 
-    if (do_binmode(fp,IoTYPE(io),TRUE)) 
+    if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp))) 
        RETPUSHYES;
     else
        RETPUSHUNDEF;
 }
 
-
 PP(pp_tie)
 {
     djSP;
@@ -1579,10 +1588,11 @@ PP(pp_send)
     djSP; dMARK; dORIGMARK; dTARGET;
     GV *gv;
     IO *io;
-    Off_t offset;
     SV *bufsv;
     char *buffer;
-    Off_t length;
+    Size_t length;
+    SSize_t retval;
+    IV offset;
     STRLEN blen;
     MAGIC *mg;
 
@@ -1605,17 +1615,17 @@ PP(pp_send)
        goto say_undef;
     bufsv = *++MARK;
     buffer = SvPV(bufsv, blen);
-#if Off_t_SIZE > IVSIZE
+#if Size_t_size > IVSIZE
     length = SvNVx(*++MARK);
 #else
     length = SvIVx(*++MARK);
 #endif
-    if (length < 0)
+    if ((Size_t)length < 0)
        DIE(aTHX_ "Negative length");
     SETERRNO(0,0);
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
-       length = -1;
+       retval = -1;
        if (ckWARN(WARN_CLOSED)) {
            if (PL_op->op_type == OP_SYSWRITE)
                report_closed_fh(gv, io, "syswrite", "filehandle");
@@ -1625,11 +1635,7 @@ PP(pp_send)
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
        if (MARK < SP) {
-#if Off_t_SIZE > IVSIZE
-           offset = SvNVx(*++MARK);
-#else
            offset = SvIVx(*++MARK);
-#endif
            if (offset < 0) {
                if (-offset > blen)
                    DIE(aTHX_ "Offset outside string");
@@ -1642,14 +1648,14 @@ PP(pp_send)
            length = blen - offset;
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
        if (IoTYPE(io) == 's') {
-           length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+           retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
                                   buffer+offset, length, 0);
        }
        else
 #endif
        {
            /* See the note at doio.c:do_print about filesize limits. --jhi */
-           length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+           retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
                                   buffer+offset, length);
        }
     }
@@ -1658,20 +1664,24 @@ PP(pp_send)
        char *sockbuf;
        STRLEN mlen;
        sockbuf = SvPVx(*++MARK, mlen);
-       length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
-                               (struct sockaddr *)sockbuf, mlen);
+       retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+                                length, (struct sockaddr *)sockbuf, mlen);
     }
     else
-       length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+       retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
 
 #else
     else
        DIE(aTHX_ PL_no_sock_func, "send");
 #endif
-    if (length < 0)
+    if (retval < 0)
        goto say_undef;
     SP = ORIGMARK;
-    PUSHi(length);
+#if Size_t_size > IVSIZE
+    PUSHn(retval);
+#else
+    PUSHi(retval);
+#endif
     RETURN;
 
   say_undef:
@@ -1817,11 +1827,24 @@ PP(pp_sysseek)
 PP(pp_truncate)
 {
     djSP;
-    Off_t len = (Off_t)POPn;
+    /* There seems to be no consensus on the length type of truncate()
+     * and ftruncate(), both off_t and size_t have supporters. In
+     * general one would think that when using large files, off_t is
+     * at least as wide as size_t, so using an off_t should be okay. */
+    /* XXX Configure probe for the length type of *truncate() needed XXX */
+    Off_t len;
     int result = 1;
     GV *tmpgv;
     STRLEN n_a;
 
+#if Size_t_size > IVSIZE
+    len = (Off_t)POPn;
+#else
+    len = (Off_t)POPi;
+#endif
+    /* Checking for length < 0 is problematic as the type might or
+     * might not be signed: if it is not, clever compilers will moan. */ 
+    /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
     SETERRNO(0,0);
 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
     if (PL_op->op_flags & OPf_SPECIAL) {