summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-04-27 18:48:21 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-04-27 18:48:21 (GMT)
commit7842c9275791d34656b40014d43e8177a94010ad (patch)
treeaa7be44c0131f5a0a25dbcef7634100323b8a039 /generic
parentec3f17501d816894810d4d4ea984e4f60e6217fe (diff)
downloadtcl-7842c9275791d34656b40014d43e8177a94010ad.zip
tcl-7842c9275791d34656b40014d43e8177a94010ad.tar.gz
tcl-7842c9275791d34656b40014d43e8177a94010ad.tar.bz2
TIP#183 IMPLEMENTATION [Patch 577093]
* generic/tclIOUtil.c (TclGetOpenModeEx): New routine. * generic/tclInt.h: * generic/tclIO.c (Tcl_OpenObjCmd): Support for "b" and * doc/open.n: "BINARY" in "access" argument to [open]. * tests/ioCmd.test:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIOCmd.c9
-rw-r--r--generic/tclIOUtil.c103
-rw-r--r--generic/tclInt.h6
3 files changed, 91 insertions, 27 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 732b162..fc14619 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.22 2004/10/07 00:24:49 dgp Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.23 2005/04/27 18:48:25 dgp Exp $
*/
#include "tclInt.h"
@@ -960,14 +960,14 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
if (!pipeline) {
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
- int mode, seekFlag, cmdObjc;
+ int mode, seekFlag, cmdObjc, binary;
CONST char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
chan = NULL;
} else {
@@ -987,6 +987,9 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
break;
}
chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
+ if (binary) {
+ Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+ }
}
ckfree((char *) cmdArgv);
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6fc27f0..17d6efa 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.116 2005/04/16 08:04:56 vasiljevic Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.117 2005/04/27 18:48:25 dgp Exp $
*/
#include "tclInt.h"
@@ -1412,9 +1412,43 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
* TclGetOpenMode --
*
* Description:
+ * This routine is an obsolete, limited version of
+ * TclGetOpenModeEx() below. It exists only to satisfy any
+ * extensions imprudently using it via Tcl's internal stubs table.
+ *
+ * Results:
+ * Same as TclGetOpenModeEx().
+ *
+ * Side effects:
+ * Same as TclGetOpenModeEx().
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetOpenMode(interp, modeString, seekFlagPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting - may be NULL. */
+ CONST char *modeString; /* Mode string, e.g. "r+" or
+ * "RDONLY CREAT". */
+ int *seekFlagPtr; /* Set this to 1 if the caller
+ * should seek to EOF during the
+ * opening of the file. */
+{
+ int binary = 0;
+ return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetOpenModeEx --
+ *
+ * Description:
* Computes a POSIX mode mask for opening a file, from a given string,
- * and also sets a flag to indicate whether the caller should seek to
- * EOF after opening the file.
+ * and also sets flags to indicate whether the caller should seek to
+ * EOF after opening the file, and whether the caller should
+ * configure the channel for binary data.
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
@@ -1423,7 +1457,9 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller
- * to seek to EOF after opening the file.
+ * to seek to EOF after opening the file, or to 0 otherwise. Sets the
+ * integer referenced by binaryPtr to 1 to tell the caller to seek to
+ * configure the channel for binary data, or to 0 otherwise.
*
* Special note:
* This code is based on a prototype implementation contributed
@@ -1431,16 +1467,18 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
*
*---------------------------------------------------------------------------
*/
-
int
-TclGetOpenMode(interp, string, seekFlagPtr)
+TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
- CONST char *string; /* Mode string, e.g. "r+" or
+ CONST char *modeString; /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
int *seekFlagPtr; /* Set this to 1 if the caller
* should seek to EOF during the
* opening of the file. */
+ int *binaryPtr; /* Set this to 1 if the caller
+ * should configure the opened
+ * channel for binary operations */
{
int mode, modeArgc, c, i, gotRW;
CONST char **modeArgv, *flag;
@@ -1453,6 +1491,7 @@ TclGetOpenMode(interp, string, seekFlagPtr)
*/
*seekFlagPtr = 0;
+ *binaryPtr = 0;
mode = 0;
/*
@@ -1460,9 +1499,9 @@ TclGetOpenMode(interp, string, seekFlagPtr)
* routines.
*/
- if (!(string[0] & 0x80)
- && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
- switch (string[0]) {
+ if (!(modeString[0] & 0x80)
+ && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
+ switch (modeString[0]) {
case 'r':
mode = O_RDONLY;
break;
@@ -1475,20 +1514,33 @@ TclGetOpenMode(interp, string, seekFlagPtr)
break;
default:
error:
+ *seekFlagPtr = 0;
+ *binaryPtr = 0;
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
- "illegal access mode \"", string, "\"",
+ "illegal access mode \"", modeString, "\"",
(char *) NULL);
}
return -1;
}
- if (string[1] == '+') {
- mode &= ~(O_RDONLY|O_WRONLY);
- mode |= O_RDWR;
- if (string[2] != 0) {
+ i=1;
+ while (i<3 && modeString[i]) {
+ if (modeString[i] == modeString[i-1]) {
goto error;
}
- } else if (string[1] != 0) {
+ switch (modeString[i++]) {
+ case '+':
+ mode &= ~(O_RDONLY|O_WRONLY);
+ mode |= O_RDWR;
+ break;
+ case 'b':
+ *binaryPtr = 1;
+ break;
+ default:
+ goto error;
+ }
+ }
+ if (modeString[i] != 0) {
goto error;
}
return mode;
@@ -1502,11 +1554,11 @@ TclGetOpenMode(interp, string, seekFlagPtr)
* a NULL interpreter is passed in.
*/
- if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
+ if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
- Tcl_AddErrorInfo(interp, string);
+ Tcl_AddErrorInfo(interp, modeString);
Tcl_AddErrorInfo(interp, "\"");
}
return -1;
@@ -1560,11 +1612,14 @@ TclGetOpenMode(interp, string, seekFlagPtr)
#endif
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
mode |= O_TRUNC;
+ } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
+ *binaryPtr = 1;
} else {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
- " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
+ "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
+ "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
+ (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
@@ -2086,8 +2141,8 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
if (fsPtr != NULL) {
Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
if (proc != NULL) {
- int mode, seekFlag;
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ int mode, seekFlag, binary;
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
return NULL;
}
@@ -2106,6 +2161,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
return NULL;
}
}
+ if (binary) {
+ Tcl_SetChannelOption(interp, retVal,
+ "-translation", "binary");
+ }
}
return retVal;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 727b879..e0779ef 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.225 2005/04/22 15:46:57 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.226 2005/04/27 18:48:25 dgp Exp $
*/
#ifndef _TCLINT
@@ -1889,7 +1889,9 @@ MODULE_SCOPE int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Namespace **nsPtrPtr));
-
+MODULE_SCOPE int TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *modeString, int *seekFlagPtr,
+ int *binaryPtr));
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ ((
ProcessGlobalValue *pgvPtr));
MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,