summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2019-04-30 18:31:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2019-04-30 18:31:47 (GMT)
commitfd0444bf94a1f315cb724abf0374890fb9b7e310 (patch)
tree0f00fe6bd053e3af9122c8ae8927992772e227ea /generic
parentae1d2d2d40e05b234f974ec40e5f073f10107b42 (diff)
downloadtcl-fd0444bf94a1f315cb724abf0374890fb9b7e310.zip
tcl-fd0444bf94a1f315cb724abf0374890fb9b7e310.tar.gz
tcl-fd0444bf94a1f315cb724abf0374890fb9b7e310.tar.bz2
Implementation of [file tempdir]; hand-tested on OSX...
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdAH.c1
-rw-r--r--generic/tclFCmd.c147
-rw-r--r--generic/tclInt.h1
3 files changed, 148 insertions, 1 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 1811c5c..dd98ef3 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1093,6 +1093,7 @@ TclInitFileCmd(
{"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1},
{"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"tempdir", TclFileTempDirCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
{"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a4dded2..8ef0456 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1345,7 +1345,7 @@ TclFileReadLinkCmd(
/*
*---------------------------------------------------------------------------
*
- * TclFileTemporaryCmd
+ * TclFileTemporaryCmd --
*
* This function implements the "tempfile" subcommand of the "file"
* command.
@@ -1505,6 +1505,151 @@ TclFileTemporaryCmd(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileTempDirCmd --
+ *
+ * This function implements the "tempdir" subcommand of the "file"
+ * command.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Creates a temporary directory.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclFileTempDirCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirNameObj; /* Object that will contain the directory
+ * name. */
+ Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL;
+ /* Pieces of template. Each piece is NULL if
+ * it is omitted. The platform temporary file
+ * engine might ignore some pieces. */
+
+ if (objc < 1 || objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?template?");
+ return TCL_ERROR;
+ }
+
+ if (objc > 1) {
+ int length;
+ Tcl_Obj *templateObj = objv[1];
+ const char *string = TclGetStringFromObj(templateObj, &length);
+ const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);
+
+ /*
+ * 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, and only gives a base name if there's at least one
+ * character after the last directory separator.
+ */
+
+ if (strchr(string, '/') == NULL
+ && (!onWindows || strchr(string, '\\') == NULL)) {
+ /*
+ * No directory separator, so just assume we have a file name.
+ * This is a bit wrong on Windows where we could have problems
+ * with disk name prefixes... but those are much less common in
+ * naked form so we just pass through and let the OS figure it out
+ * instead.
+ */
+
+ nameBaseObj = templateObj;
+ Tcl_IncrRefCount(nameBaseObj);
+ } else if (string[length-1] != '/'
+ && (!onWindows || string[length-1] != '\\')) {
+ /*
+ * If the template has a non-terminal directory separator, split
+ * into dirname and tail.
+ */
+
+ baseDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
+ nameBaseObj = TclPathPart(interp, templateObj, TCL_PATH_TAIL);
+ } else {
+ /*
+ * Otherwise, there must be a terminal directory separator, so
+ * just the directory is given.
+ */
+
+ baseDirObj = templateObj;
+ Tcl_IncrRefCount(baseDirObj);
+ }
+
+ /*
+ * Only allow creation of temporary directories in the native
+ * filesystem since they are frequently used for integration with
+ * external tools or system libraries.
+ */
+
+ if (baseDirObj != NULL && Tcl_FSGetFileSystemForPath(baseDirObj)
+ != &tclNativeFilesystem) {
+ TclDecrRefCount(baseDirObj);
+ baseDirObj = NULL;
+ }
+ }
+
+ /*
+ * Convert empty parts of the template into unspecified parts.
+ */
+
+ if (baseDirObj && !TclGetString(baseDirObj)[0]) {
+ TclDecrRefCount(baseDirObj);
+ baseDirObj = NULL;
+ }
+ if (nameBaseObj && !TclGetString(nameBaseObj)[0]) {
+ TclDecrRefCount(nameBaseObj);
+ nameBaseObj = NULL;
+ }
+
+ /*
+ * Create and open the temporary file.
+ */
+
+ makeTemporary:
+ dirNameObj = TclpCreateTemporaryDirectory(baseDirObj, nameBaseObj);
+
+ /*
+ * If we created pieces of template, get rid of them now.
+ */
+
+ if (baseDirObj) {
+ TclDecrRefCount(baseDirObj);
+ }
+ if (nameBaseObj) {
+ TclDecrRefCount(nameBaseObj);
+ }
+
+ /*
+ * Deal with results.
+ */
+
+ if (dirNameObj == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create temporary directory: %s",
+ Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, dirNameObj);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3db1264..9a2ef85 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2967,6 +2967,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);