diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2008-11-29 18:17:19 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2008-11-29 18:17:19 (GMT) |
commit | d4fe85608c6a720a326e2fcf70e24364f8af4119 (patch) | |
tree | b36ec8359c7c09cfe35cc031cbaa67d2737d1803 /generic/tclCmdAH.c | |
parent | c2e6687a1fb90743f1c56b21cde68e1344b202cc (diff) | |
download | tcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.zip tcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.tar.gz tcl-d4fe85608c6a720a326e2fcf70e24364f8af4119.tar.bz2 |
Implementation of TIP #210.
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r-- | generic/tclCmdAH.c | 159 |
1 files changed, 154 insertions, 5 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 -- |