diff options
Diffstat (limited to 'generic/tclFCmd.c')
| -rw-r--r-- | generic/tclFCmd.c | 552 |
1 files changed, 342 insertions, 210 deletions
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index d975cc6..c169427 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFCmd.c,v 1.6 1999/07/01 23:21:07 redman Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.7 2001/07/31 19:12:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -20,14 +20,14 @@ */ static int CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp, - char *source, char *dest, int copyFlag, - int force)); -static char * FileBasename _ANSI_ARGS_((Tcl_Interp *interp, - char *path, Tcl_DString *bufferPtr)); + Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, + int copyFlag, int force)); +static Tcl_Obj * FileBasename _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr)); static int FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp, - int argc, char **argv, int copyFlag)); + int objc, Tcl_Obj *CONST objv[], int copyFlag)); static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp, - int argc, char **argv, int *forcePtr)); + int objc, Tcl_Obj *CONST objv[], int *forcePtr)); /* *--------------------------------------------------------------------------- @@ -49,12 +49,12 @@ static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp, */ int -TclFileRenameCmd(interp, argc, argv) +TclFileRenameCmd(interp, objc, objv) Tcl_Interp *interp; /* Interp for error reporting. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings passed to Tcl_FileCmd. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */ { - return FileCopyRename(interp, argc, argv, 0); + return FileCopyRename(interp, objc, objv, 0); } /* @@ -77,12 +77,12 @@ TclFileRenameCmd(interp, argc, argv) */ int -TclFileCopyCmd(interp, argc, argv) +TclFileCopyCmd(interp, objc, objv) Tcl_Interp *interp; /* Used for error reporting */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings passed to Tcl_FileCmd. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */ { - return FileCopyRename(interp, argc, argv, 1); + return FileCopyRename(interp, objc, objv, 1); } /* @@ -103,26 +103,26 @@ TclFileCopyCmd(interp, argc, argv) */ static int -FileCopyRename(interp, argc, argv, copyFlag) +FileCopyRename(interp, objc, objv, copyFlag) Tcl_Interp *interp; /* Used for error reporting. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings passed to Tcl_FileCmd. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */ int copyFlag; /* If non-zero, copy source(s). Otherwise, * rename them. */ { int i, result, force; struct stat statBuf; - Tcl_DString targetBuffer; - char *target; + Tcl_Obj *target; - i = FileForceOption(interp, argc - 2, argv + 2, &force); + i = FileForceOption(interp, objc - 2, objv + 2, &force); if (i < 0) { return TCL_ERROR; } i += 2; - if ((argc - i) < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " ?options? source ?source ...? target\"", + if ((objc - i) < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), + " ?options? source ?source ...? target\"", (char *) NULL); return TCL_ERROR; } @@ -133,38 +133,38 @@ FileCopyRename(interp, argc, argv, copyFlag) * directory. */ - target = Tcl_TranslateFileName(interp, argv[argc - 1], &targetBuffer); - if (target == NULL) { + target = objv[objc - 1]; + if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) { return TCL_ERROR; } result = TCL_OK; /* - * Call TclStat() so that if target is a symlink that points to a + * Call Tcl_FSStat() so that if target is a symlink that points to a * directory we will put the sources in that directory instead of * overwriting the symlink. */ - if ((TclStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) { - if ((argc - i) > 2) { + if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) { + if ((objc - i) > 2) { errno = ENOTDIR; Tcl_PosixError(interp); Tcl_AppendResult(interp, "error ", ((copyFlag) ? "copying" : "renaming"), ": target \"", - argv[argc - 1], "\" is not a directory", (char *) NULL); + Tcl_GetString(target), "\" is not a directory", + (char *) NULL); result = TCL_ERROR; } else { /* - * Even though already have target == translated(argv[i+1]), + * Even though already have target == translated(objv[i+1]), * pass the original argument down, so if there's an error, the * error message will reflect the original arguments. */ - result = CopyRenameOneFile(interp, argv[i], argv[i + 1], copyFlag, + result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag, force); } - Tcl_DStringFree(&targetBuffer); return result; } @@ -173,30 +173,30 @@ FileCopyRename(interp, argc, argv, copyFlag) * from each source, and append it to the end of the target path. */ - for ( ; i < argc - 1; i++) { - char *jargv[2]; - char *source, *newFileName; - Tcl_DString sourceBuffer, newFileNameBuffer; - - source = FileBasename(interp, argv[i], &sourceBuffer); + for ( ; i < objc - 1; i++) { + Tcl_Obj *jargv[2]; + Tcl_Obj *source, *newFileName; + Tcl_Obj *temp; + + source = FileBasename(interp, objv[i]); if (source == NULL) { result = TCL_ERROR; break; } - jargv[0] = argv[argc - 1]; + jargv[0] = objv[objc - 1]; jargv[1] = source; - Tcl_DStringInit(&newFileNameBuffer); - newFileName = Tcl_JoinPath(2, jargv, &newFileNameBuffer); - result = CopyRenameOneFile(interp, argv[i], newFileName, copyFlag, + temp = Tcl_NewListObj(2, jargv); + newFileName = Tcl_FSJoinPath(temp, -1); + Tcl_IncrRefCount(newFileName); + Tcl_DecrRefCount(temp); + + result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag, force); - Tcl_DStringFree(&sourceBuffer); - Tcl_DStringFree(&newFileNameBuffer); - + Tcl_DecrRefCount(newFileName); if (result == TCL_ERROR) { break; } } - Tcl_DStringFree(&targetBuffer); return result; } @@ -219,74 +219,72 @@ FileCopyRename(interp, argc, argv, copyFlag) *---------------------------------------------------------------------- */ int -TclFileMakeDirsCmd(interp, argc, argv) +TclFileMakeDirsCmd(interp, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ - int argc; /* Number of arguments */ - char **argv; /* Argument strings passed to Tcl_FileCmd. */ + int objc; /* Number of arguments */ + Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */ { - Tcl_DString nameBuffer, targetBuffer; - char *errfile; - int result, i, j, pargc; - char **pargv; + Tcl_Obj *errfile; + int result, i, j, pobjc; + Tcl_Obj *split = NULL; + Tcl_Obj *target = NULL; struct stat statBuf; - pargv = NULL; errfile = NULL; - Tcl_DStringInit(&nameBuffer); - Tcl_DStringInit(&targetBuffer); result = TCL_OK; - for (i = 2; i < argc; i++) { - char *name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer); - if (name == NULL) { + for (i = 2; i < objc; i++) { + if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { result = TCL_ERROR; break; } - Tcl_SplitPath(name, &pargc, &pargv); - if (pargc == 0) { + split = Tcl_FSSplitPath(objv[i],&pobjc); + if (pobjc == 0) { errno = ENOENT; - errfile = argv[i]; + errfile = objv[i]; break; } - for (j = 0; j < pargc; j++) { - char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer); - + for (j = 0; j < pobjc; j++) { + target = Tcl_FSJoinPath(split, j + 1); + Tcl_IncrRefCount(target); /* - * Call TclStat() so that if target is a symlink that points + * Call Tcl_Stat() so that if target is a symlink that points * to a directory we will create subdirectories in that * directory. */ - if (TclStat(target, &statBuf) == 0) { + if (Tcl_FSStat(target, &statBuf) == 0) { if (!S_ISDIR(statBuf.st_mode)) { errno = EEXIST; errfile = target; goto done; } } else if ((errno != ENOENT) - || (TclpCreateDirectory(target) != TCL_OK)) { + || (Tcl_FSCreateDirectory(target) != TCL_OK)) { errfile = target; goto done; } - Tcl_DStringFree(&targetBuffer); + /* Forget about this sub-path */ + Tcl_DecrRefCount(target); + target = NULL; } - ckfree((char *) pargv); - pargv = NULL; - Tcl_DStringFree(&nameBuffer); + Tcl_DecrRefCount(split); + split = NULL; } done: if (errfile != NULL) { Tcl_AppendResult(interp, "can't create directory \"", - errfile, "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), + (char *) NULL); result = TCL_ERROR; } - - Tcl_DStringFree(&nameBuffer); - Tcl_DStringFree(&targetBuffer); - if (pargv != NULL) { - ckfree((char *) pargv); + if (split != NULL) { + Tcl_DecrRefCount(split); + } + if (target != NULL) { + Tcl_DecrRefCount(target); } return result; } @@ -309,39 +307,34 @@ TclFileMakeDirsCmd(interp, argc, argv) */ int -TclFileDeleteCmd(interp, argc, argv) +TclFileDeleteCmd(interp, objc, objv) Tcl_Interp *interp; /* Used for error reporting */ - int argc; /* Number of arguments */ - char **argv; /* Argument strings passed to Tcl_FileCmd. */ + int objc; /* Number of arguments */ + Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */ { - Tcl_DString nameBuffer, errorBuffer; int i, force, result; - char *errfile; + Tcl_Obj *errfile; - i = FileForceOption(interp, argc - 2, argv + 2, &force); + i = FileForceOption(interp, objc - 2, objv + 2, &force); if (i < 0) { return TCL_ERROR; } i += 2; - if ((argc - i) < 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " ?options? file ?file ...?\"", (char *) NULL); + if ((objc - i) < 1) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), + " ?options? file ?file ...?\"", (char *) NULL); return TCL_ERROR; } errfile = NULL; result = TCL_OK; - Tcl_DStringInit(&errorBuffer); - Tcl_DStringInit(&nameBuffer); - for ( ; i < argc; i++) { + for ( ; i < objc; i++) { struct stat statBuf; - char *name; - errfile = argv[i]; - Tcl_DStringSetLength(&nameBuffer, 0); - name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer); - if (name == NULL) { + errfile = objv[i]; + if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { result = TCL_ERROR; goto done; } @@ -350,7 +343,7 @@ TclFileDeleteCmd(interp, argc, argv) * Call lstat() to get info so can delete symbolic link itself. */ - if (TclpLstat(name, &statBuf) != 0) { + if (Tcl_FSLstat(objv[i], &statBuf) != 0) { /* * Trying to delete a file that does not exist is not * considered an error, just a no-op @@ -360,10 +353,12 @@ TclFileDeleteCmd(interp, argc, argv) result = TCL_ERROR; } } else if (S_ISDIR(statBuf.st_mode)) { - result = TclpRemoveDirectory(name, force, &errorBuffer); + Tcl_Obj *errorBuffer = NULL; + result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer); if (result != TCL_OK) { if ((force == 0) && (errno == EEXIST)) { - Tcl_AppendResult(interp, "error deleting \"", argv[i], + Tcl_AppendResult(interp, "error deleting \"", + Tcl_GetString(objv[i]), "\": directory not empty", (char *) NULL); Tcl_PosixError(interp); goto done; @@ -373,13 +368,14 @@ TclFileDeleteCmd(interp, argc, argv) * If possible, use the untranslated name for the file. */ - errfile = Tcl_DStringValue(&errorBuffer); - if (strcmp(name, errfile) == 0) { - errfile = argv[i]; + errfile = errorBuffer; + /* FS supposed to check between translated objv and errfile */ + if (Tcl_FSEqualPaths(objv[i], errfile)) { + errfile = objv[i]; } } } else { - result = TclpDeleteFile(name); + result = Tcl_FSDeleteFile(objv[i]); } if (result == TCL_ERROR) { @@ -387,12 +383,20 @@ TclFileDeleteCmd(interp, argc, argv) } } if (result != TCL_OK) { - Tcl_AppendResult(interp, "error deleting \"", errfile, - "\": ", Tcl_PosixError(interp), (char *) NULL); + if (errfile == NULL) { + /* + * We try to accomodate poor error results from our + * Tcl_FS calls + */ + Tcl_AppendResult(interp, "error deleting unknown file: ", + Tcl_PosixError(interp), (char *) NULL); + } else { + Tcl_AppendResult(interp, "error deleting \"", + Tcl_GetString(errfile), "\": ", + Tcl_PosixError(interp), (char *) NULL); + } } done: - Tcl_DStringFree(&errorBuffer); - Tcl_DStringFree(&nameBuffer); return result; } @@ -418,9 +422,9 @@ TclFileDeleteCmd(interp, argc, argv) static int CopyRenameOneFile(interp, source, target, copyFlag, force) Tcl_Interp *interp; /* Used for error reporting. */ - char *source; /* Pathname of file to copy. May need to + Tcl_Obj *source; /* Pathname of file to copy. May need to * be translated. */ - char *target; /* Pathname of file to create/overwrite. + Tcl_Obj *target; /* Pathname of file to create/overwrite. * May need to be translated. */ int copyFlag; /* If non-zero, copy files. Otherwise, * rename them. */ @@ -429,23 +433,19 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) * exists. */ { int result; - Tcl_DString sourcePath, targetPath, errorBuffer; - char *targetName, *sourceName, *errfile; + Tcl_Obj *errfile, *errorBuffer; struct stat sourceStatBuf, targetStatBuf; - sourceName = Tcl_TranslateFileName(interp, source, &sourcePath); - if (sourceName == NULL) { + if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) { return TCL_ERROR; } - targetName = Tcl_TranslateFileName(interp, target, &targetPath); - if (targetName == NULL) { - Tcl_DStringFree(&sourcePath); + if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) { return TCL_ERROR; } errfile = NULL; + errorBuffer = NULL; result = TCL_ERROR; - Tcl_DStringInit(&errorBuffer); /* * We want to copy/rename links and not the files they point to, so we @@ -454,11 +454,11 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) * target. */ - if (TclpLstat(sourceName, &sourceStatBuf) != 0) { + if (Tcl_FSLstat(source, &sourceStatBuf) != 0) { errfile = source; goto done; } - if (TclpLstat(targetName, &targetStatBuf) != 0) { + if (Tcl_FSLstat(target, &targetStatBuf) != 0) { if (errno != ENOENT) { errfile = target; goto done; @@ -495,28 +495,31 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) if (S_ISDIR(sourceStatBuf.st_mode) && !S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_AppendResult(interp, "can't overwrite file \"", target, - "\" with directory \"", source, "\"", (char *) NULL); + Tcl_AppendResult(interp, "can't overwrite file \"", + Tcl_GetString(target), "\" with directory \"", + Tcl_GetString(source), "\"", (char *) NULL); goto done; } if (!S_ISDIR(sourceStatBuf.st_mode) && S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_AppendResult(interp, "can't overwrite directory \"", target, - "\" with file \"", source, "\"", (char *) NULL); + Tcl_AppendResult(interp, "can't overwrite directory \"", + Tcl_GetString(target), "\" with file \"", + Tcl_GetString(source), "\"", (char *) NULL); goto done; } } if (copyFlag == 0) { - result = TclpRenameFile(sourceName, targetName); + result = Tcl_FSRenameFile(source, target); if (result == TCL_OK) { goto done; } if (errno == EINVAL) { - Tcl_AppendResult(interp, "error renaming \"", source, "\" to \"", - target, "\": trying to rename a volume or ", + Tcl_AppendResult(interp, "error renaming \"", + Tcl_GetString(source), "\" to \"", + Tcl_GetString(target), "\": trying to rename a volume or ", "move a directory into itself", (char *) NULL); goto done; } else if (errno != EXDEV) { @@ -533,44 +536,122 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) } if (S_ISDIR(sourceStatBuf.st_mode)) { - result = TclpCopyDirectory(sourceName, targetName, &errorBuffer); + result = Tcl_FSCopyDirectory(source, target, &errorBuffer); if (result != TCL_OK) { - errfile = Tcl_DStringValue(&errorBuffer); - if (strcmp(errfile, sourceName) == 0) { - errfile = source; - } else if (strcmp(errfile, targetName) == 0) { - errfile = target; + if (errno == EXDEV) { + /* + * The copy failed because we're trying to do a + * cross-filesystem copy. We do this through our Tcl + * library. + */ + Tcl_SavedResult savedResult; + Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL); + Tcl_IncrRefCount(copyCommand); + Tcl_ListObjAppendElement(interp, copyCommand, + Tcl_NewStringObj("::tcl::CopyDirectory",-1)); + if (copyFlag) { + Tcl_ListObjAppendElement(interp, copyCommand, + Tcl_NewStringObj("copying",-1)); + } else { + Tcl_ListObjAppendElement(interp, copyCommand, + Tcl_NewStringObj("renaming",-1)); + } + Tcl_ListObjAppendElement(interp, copyCommand, source); + Tcl_ListObjAppendElement(interp, copyCommand, target); + Tcl_SaveResult(interp, &savedResult); + result = Tcl_EvalObjEx(interp, copyCommand, + TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + Tcl_DecrRefCount(copyCommand); + if (result != TCL_OK) { + /* + * There was an error in the Tcl-level copy. + * We will pass on the Tcl error message and + * can ensure this by setting errfile to NULL + */ + Tcl_DiscardResult(&savedResult); + errfile = NULL; + } else { + /* The copy was successful */ + Tcl_RestoreResult(interp, &savedResult); + } + } else { + errfile = errorBuffer; + if (Tcl_FSEqualPaths(errfile, source)) { + errfile = source; + } else if (Tcl_FSEqualPaths(errfile, target)) { + errfile = target; + } } } } else { - result = TclpCopyFile(sourceName, targetName); - if (result != TCL_OK) { + result = Tcl_FSCopyFile(source, target); + if ((result != TCL_OK) && (errno == EXDEV)) { /* * Well, there really shouldn't be a problem with source, * because up there we checked to see if it was ok to copy it. + * + * Either there is a problem with target, or we're trying + * to do a cross-filesystem copy. We open the target for + * writing to decide between those two cases. */ - - errfile = target; + int prot = 0666; + Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot); + if (out == NULL) { + /* There was a problem with the target */ + errfile = target; + } else { + /* It looks like we can copy it over */ + Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, + "r", prot); + if (in == NULL) { + /* This is very strange, we checked this above */ + Tcl_Close(interp, out); + errfile = source; + } else { + struct utimbuf tval; + /* + * Copy it synchronously. We might wish to add an + * asynchronous option to support vfs's which are + * slow (e.g. network sockets). + */ + Tcl_SetChannelOption(interp, in, "-translation", "binary"); + Tcl_SetChannelOption(interp, out, "-translation", "binary"); + + if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) { + result = TCL_OK; + } + /* + * If the copy failed, assume that copy channel left + * a good error message. + */ + Tcl_Close(interp, in); + Tcl_Close(interp, out); + /* Set modification date of copied file */ + tval.actime = sourceStatBuf.st_atime; + tval.modtime = sourceStatBuf.st_mtime; + Tcl_FSUtime(source, &tval); + } + } } } if ((copyFlag == 0) && (result == TCL_OK)) { if (S_ISDIR(sourceStatBuf.st_mode)) { - result = TclpRemoveDirectory(sourceName, 1, &errorBuffer); + result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer); if (result != TCL_OK) { - errfile = Tcl_DStringValue(&errorBuffer); - if (strcmp(errfile, sourceName) == 0) { + if (Tcl_FSEqualPaths(errfile, source) == 0) { errfile = source; } } } else { - result = TclpDeleteFile(sourceName); + result = Tcl_FSDeleteFile(source); if (result != TCL_OK) { errfile = source; } } if (result != TCL_OK) { - Tcl_AppendResult(interp, "can't unlink \"", errfile, "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "can't unlink \"", + Tcl_GetString(errfile), "\": ", + Tcl_PosixError(interp), (char *) NULL); errfile = NULL; } } @@ -579,19 +660,21 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) if (errfile != NULL) { Tcl_AppendResult(interp, ((copyFlag) ? "error copying \"" : "error renaming \""), - source, (char *) NULL); + Tcl_GetString(source), (char *) NULL); if (errfile != source) { - Tcl_AppendResult(interp, "\" to \"", target, (char *) NULL); + Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target), + (char *) NULL); if (errfile != target) { - Tcl_AppendResult(interp, "\": \"", errfile, (char *) NULL); + Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile), + (char *) NULL); } } Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), (char *) NULL); } - Tcl_DStringFree(&errorBuffer); - Tcl_DStringFree(&sourcePath); - Tcl_DStringFree(&targetPath); + if (errorBuffer != NULL) { + Tcl_DecrRefCount(errorBuffer); + } return result; } @@ -616,10 +699,10 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) */ static int -FileForceOption(interp, argc, argv, forcePtr) +FileForceOption(interp, objc, objv, forcePtr) Tcl_Interp *interp; /* Interp, for error return. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. First command line + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. First command line * option, if it exists, begins at 0. */ int *forcePtr; /* If the "-force" was specified, *forcePtr * is filled with 1, otherwise with 0. */ @@ -627,17 +710,17 @@ FileForceOption(interp, argc, argv, forcePtr) int force, i; force = 0; - for (i = 0; i < argc; i++) { - if (argv[i][0] != '-') { + for (i = 0; i < objc; i++) { + if (Tcl_GetString(objv[i])[0] != '-') { break; } - if (strcmp(argv[i], "-force") == 0) { + if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) { force = 1; - } else if (strcmp(argv[i], "--") == 0) { + } else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) { i++; break; } else { - Tcl_AppendResult(interp, "bad option \"", argv[i], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]), "\": should be -force or --", (char *)NULL); return -1; } @@ -667,47 +750,51 @@ FileForceOption(interp, argc, argv, forcePtr) *--------------------------------------------------------------------------- */ -static char * -FileBasename(interp, path, bufferPtr) +static Tcl_Obj * +FileBasename(interp, pathPtr) Tcl_Interp *interp; /* Interp, for error return. */ - char *path; /* Path whose basename to extract. */ - Tcl_DString *bufferPtr; /* Initialized DString that receives - * basename. */ + Tcl_Obj *pathPtr; /* Path whose basename to extract. */ { - int argc; - char **argv; + int objc; + Tcl_Obj *split; + Tcl_Obj *resPtr = NULL; - Tcl_SplitPath(path, &argc, &argv); - if (argc == 0) { - Tcl_DStringInit(bufferPtr); - } else { - if ((argc == 1) && (*path == '~')) { - Tcl_DString buffer; + split = Tcl_FSSplitPath(pathPtr, &objc); + + if (objc != 0) { + if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) { - ckfree((char *) argv); - path = Tcl_TranslateFileName(interp, path, &buffer); - if (path == NULL) { + if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { + Tcl_DecrRefCount(split); return NULL; } - Tcl_SplitPath(path, &argc, &argv); - Tcl_DStringFree(&buffer); + Tcl_DecrRefCount(split); + split = Tcl_FSSplitPath(pathPtr, &objc); } - Tcl_DStringInit(bufferPtr); /* * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ - if (argc > 0) { - if ((argc > 1) - || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) { - Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1); + if (objc > 0) { + if (objc > 1) { + Tcl_ListObjIndex(NULL, split, objc-1, &resPtr); + } else { + Tcl_Obj *temp; + Tcl_ListObjIndex(NULL, split, 0, &temp); + if (Tcl_GetPathType(Tcl_GetString(temp)) == TCL_PATH_RELATIVE) { + Tcl_ListObjIndex(NULL, split, objc-1, &resPtr); + } } } } - ckfree((char *) argv); - return Tcl_DStringValue(bufferPtr); + if (resPtr == NULL) { + resPtr = Tcl_NewStringObj("",0); + } + Tcl_IncrRefCount(resPtr); + Tcl_DecrRefCount(split); + return resPtr; } /* @@ -715,15 +802,15 @@ FileBasename(interp, path, bufferPtr) * * TclFileAttrsCmd -- * - * Sets or gets the platform-specific attributes of a file. The objc-objv - * points to the file name with the rest of the command line following. - * This routine uses platform-specific tables of option strings - * and callbacks. The callback to get the attributes take three - * parameters: + * Sets or gets the platform-specific attributes of a file. The + * objc-objv points to the file name with the rest of the command + * line following. This routine uses platform-specific tables of + * option strings and callbacks. The callback to get the + * attributes take three parameters: * Tcl_Interp *interp; The interp to report errors with. * Since this is an object-based API, - * the object form of the result should be - * used. + * the object form of the result should + * be used. * CONST char *fileName; This is extracted using * Tcl_TranslateFileName. * TclObj **attrObjPtrPtr; A new object to hold the attribute @@ -751,46 +838,67 @@ TclFileAttrsCmd(interp, objc, objv) int objc; /* Number of command line arguments. */ Tcl_Obj *CONST objv[]; /* The command line objects. */ { - char *fileName; int result; - Tcl_DString buffer; - + char ** attributeStrings; + Tcl_Obj* objStrings = NULL; + int numObjStrings = -1; + Tcl_Obj *filePtr; + if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "name ?option? ?value? ?option value ...?"); return TCL_ERROR; } - fileName = Tcl_GetString(objv[2]); - fileName = Tcl_TranslateFileName(interp, fileName, &buffer); - if (fileName == NULL) { + filePtr = objv[2]; + if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) { return TCL_ERROR; } objc -= 3; objv += 3; result = TCL_ERROR; - + attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); + if (attributeStrings == NULL) { + int index; + Tcl_Obj *objPtr; + if (objStrings == NULL) { + goto end; + } + /* We own the object now */ + Tcl_IncrRefCount(objStrings); + /* Use objStrings as a list object */ + if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { + goto end; + } + attributeStrings = (char**)ckalloc((1+numObjStrings)*sizeof(char*)); + for (index = 0; index < numObjStrings; index++) { + Tcl_ListObjIndex(interp, objStrings, index, &objPtr); + attributeStrings[index] = Tcl_GetString(objPtr); + } + attributeStrings[index] = NULL; + } if (objc == 0) { /* * Get all attributes. */ int index; - Tcl_Obj *listPtr, *objPtr; + Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); - for (index = 0; tclpFileAttrStrings[index] != NULL; index++) { - objPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1); + for (index = 0; attributeStrings[index] != NULL; index++) { + Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1); Tcl_ListObjAppendElement(interp, listPtr, objPtr); - - if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName, - &objPtr) != TCL_OK) { + /* We now forget about objPtr, it is in the list */ + objPtr = NULL; + if (Tcl_FSFileAttrsGet(interp, index, filePtr, + &objPtr) != TCL_OK) { Tcl_DecrRefCount(listPtr); goto end; } Tcl_ListObjAppendElement(interp, listPtr, objPtr); - } + } Tcl_SetObjResult(interp, listPtr); } else if (objc == 1) { /* @@ -798,13 +906,20 @@ TclFileAttrsCmd(interp, objc, objv) */ int index; - Tcl_Obj *objPtr; - - if (Tcl_GetIndexFromObj(interp, objv[0], tclpFileAttrStrings, + Tcl_Obj *objPtr = NULL; + + if (numObjStrings == 0) { + Tcl_AppendResult(interp, "bad option \"", + Tcl_GetString(objv[0]), "\", there are no file attributes" + " in this filesystem.", (char *) NULL); + goto end; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, "option", 0, &index) != TCL_OK) { goto end; - } - if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName, + } + if (Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtr) != TCL_OK) { goto end; } @@ -816,8 +931,15 @@ TclFileAttrsCmd(interp, objc, objv) int i, index; + if (numObjStrings == 0) { + Tcl_AppendResult(interp, "bad option \"", + Tcl_GetString(objv[0]), "\", there are no file attributes" + " in this filesystem.", (char *) NULL); + goto end; + } + for (i = 0; i < objc ; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings, + if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, "option", 0, &index) != TCL_OK) { goto end; } @@ -827,7 +949,7 @@ TclFileAttrsCmd(interp, objc, objv) (char *) NULL); goto end; } - if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName, + if (Tcl_FSFileAttrsSet(interp, index, filePtr, objv[i + 1]) != TCL_OK) { goto end; } @@ -836,6 +958,16 @@ TclFileAttrsCmd(interp, objc, objv) result = TCL_OK; end: - Tcl_DStringFree(&buffer); + if (numObjStrings != -1) { + /* Free up the array we allocated */ + ckfree((char*)attributeStrings); + /* + * We don't need this object that was passed to us + * any more. + */ + if (objStrings != NULL) { + Tcl_DecrRefCount(objStrings); + } + } return result; } |