summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-11-29 18:17:19 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-11-29 18:17:19 (GMT)
commitd4fe85608c6a720a326e2fcf70e24364f8af4119 (patch)
treeb36ec8359c7c09cfe35cc031cbaa67d2737d1803 /generic
parentc2e6687a1fb90743f1c56b21cde68e1344b202cc (diff)
downloadtcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.zip
tcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.tar.gz
tcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.tar.bz2
Implementation of TIP #210.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdAH.c159
-rw-r--r--generic/tclInt.h5
2 files changed, 158 insertions, 6 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index df24e16..19ef57e 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.109 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.110 2008/11/29 18:17:20 dkf Exp $
*/
#include "tclInt.h"
@@ -45,6 +45,8 @@ static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static int EncodingDirsObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int FileTempfileCmd(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static inline int ForeachAssignments(Tcl_Interp *interp,
struct ForeachState *statePtr);
static inline void ForeachCleanup(Tcl_Interp *interp,
@@ -893,8 +895,8 @@ Tcl_FileObjCmd(
"normalize", "owned",
"pathtype", "readable", "readlink", "rename",
"rootname", "separator", "size", "split",
- "stat", "system",
- "tail", "type", "volumes", "writable",
+ "stat", "system", "tail", "tempfile",
+ "type", "volumes", "writable",
NULL
};
enum options {
@@ -906,8 +908,8 @@ Tcl_FileObjCmd(
FCMD_NORMALIZE, FCMD_OWNED,
FCMD_PATHTYPE, FCMD_READABLE, FCMD_READLINK, FCMD_RENAME,
FCMD_ROOTNAME, FCMD_SEPARATOR, FCMD_SIZE, FCMD_SPLIT,
- FCMD_STAT, FCMD_SYSTEM,
- FCMD_TAIL, FCMD_TYPE, FCMD_VOLUMES, FCMD_WRITABLE
+ FCMD_STAT, FCMD_SYSTEM, FCMD_TAIL, FCMD_TEMPFILE,
+ FCMD_TYPE, FCMD_VOLUMES, FCMD_WRITABLE
};
if (objc < 2) {
@@ -1414,6 +1416,8 @@ Tcl_FileObjCmd(
Tcl_DecrRefCount(dirPtr);
return TCL_OK;
}
+ case FCMD_TEMPFILE:
+ return FileTempfileCmd(interp, objc, objv);
case FCMD_VOLUMES:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -1635,6 +1639,151 @@ GetTypeFromMode(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * FileTempfileCmd
+ *
+ * This function implements the "tempfile" subcommand of the "file"
+ * command.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Creates a temporary file. Opens a channel to that file and puts the
+ * name of that channel in the result. *Might* register suitable exit
+ * handlers to ensure that the temporary file gets deleted. Might write
+ * to a variable, so reentrancy is a potential issue.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FileTempfileCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
+ * file in. */
+ Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
+ Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
+ * file, or NULL if there's an error. */
+ Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
+ /* Pieces of template. Each piece is NULL if
+ * it is omitted. The platform temporary file
+ * engine might ignore some pieces. */
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?nameVar? ?template?");
+ return TCL_ERROR;
+ }
+
+ if (objc > 2) {
+ nameVarObj = objv[2];
+ TclNewObj(nameObj);
+ }
+ if (objc > 3) {
+ int length;
+ const char *string = TclGetStringFromObj(objv[3], &length);
+
+ /*
+ * Treat an empty string as if it wasn't there.
+ */
+
+ if (length == 0) {
+ goto makeTemporary;
+ }
+
+ /*
+ * The template only gives a directory if there is a directory
+ * separator in it.
+ */
+
+ if (strchr(string, '/') != NULL
+ || (tclPlatform == TCL_PLATFORM_WINDOWS
+ && strchr(string, '\\') != NULL)) {
+ tempDirObj = TclPathPart(interp, objv[3], TCL_PATH_DIRNAME);
+ }
+
+ /*
+ * The template only gives the filename if the last character isn't a
+ * directory separator.
+ */
+
+ if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
+ || string[length-1] != '\\')) {
+ Tcl_Obj *tailObj = TclPathPart(interp, objv[3], TCL_PATH_TAIL);
+
+ tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
+ tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
+ TclDecrRefCount(tailObj);
+ }
+ }
+
+ /*
+ * Convert empty parts of the template into unspecified parts.
+ */
+
+ if (tempDirObj && !TclGetString(tempDirObj)[0]) {
+ TclDecrRefCount(tempDirObj);
+ tempDirObj = NULL;
+ }
+ if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
+ TclDecrRefCount(tempBaseObj);
+ tempBaseObj = NULL;
+ }
+ if (tempExtObj && !TclGetString(tempExtObj)[0]) {
+ TclDecrRefCount(tempExtObj);
+ tempExtObj = NULL;
+ }
+
+ /*
+ * Create and open the temporary file.
+ */
+
+ makeTemporary:
+ chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
+
+ /*
+ * If we created pieces of template, get rid of them now.
+ */
+
+ if (tempDirObj) {
+ TclDecrRefCount(tempDirObj);
+ }
+ if (tempBaseObj) {
+ TclDecrRefCount(tempBaseObj);
+ }
+ if (tempExtObj) {
+ TclDecrRefCount(tempExtObj);
+ }
+
+ /*
+ * Deal with results.
+ */
+
+ if (chan == NULL) {
+ if (nameVarObj) {
+ TclDecrRefCount(nameObj);
+ }
+ Tcl_AppendResult(interp, "can't create temporary file: ",
+ Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+ Tcl_RegisterChannel(interp, chan);
+ if (nameVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_UnregisterChannel(interp, chan);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_ForObjCmd --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 027e93e..85c8c00 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,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.406 2008/11/13 22:34:33 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.407 2008/11/29 18:17:20 dkf Exp $
*/
#ifndef _TCLINT
@@ -2783,6 +2783,9 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
int linkType);
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
+MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
MODULE_SCOPE void TclpPanic(const char *format, ...);