diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclFCmd.c | 13 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 88 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 |
4 files changed, 100 insertions, 10 deletions
@@ -1,3 +1,8 @@ +2005-01-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so + that we don't need to hard-code attribute indexes. [Bug 1100671] + 2005-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/string.n: Removed the term 'set' from the documentation of diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index a74b6d6..9eb4685 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.29 2004/10/19 21:54:07 dgp Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.30 2005/01/14 14:16:53 dkf Exp $ */ #include "tclInt.h" @@ -534,10 +534,13 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) */ #if !defined(__WIN32__) { - Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1); - Tcl_IncrRefCount(perm); - Tcl_FSFileAttrsSet(NULL, 2, target, perm); - Tcl_DecrRefCount(perm); + Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1); + int index; + Tcl_IncrRefCount(perm); + if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) { + Tcl_FSFileAttrsSet(NULL, index, target, perm); + } + Tcl_DecrRefCount(perm); } #endif } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 17fd376..e4ddcd4 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.113 2004/11/17 00:31:47 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.114 2005/01/14 14:16:51 dkf Exp $ */ #include "tclInt.h" @@ -2292,6 +2292,83 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef) /* *---------------------------------------------------------------------- * + * TclFSFileAttrIndex -- + * + * Helper function for converting an attribute name to an index + * into the attribute table. + * + * Results: + * Tcl result code, index written to *indexPtr on result==TCL_OK + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclFSFileAttrIndex(pathPtr, attributeName, indexPtr) + Tcl_Obj *pathPtr; /* File whose attributes are to be + * indexed into. */ + CONST char *attributeName; /* The attribute being looked for. */ + int *indexPtr; /* Where to write the found index. */ +{ + Tcl_Obj *listObj = NULL; + CONST char **attrTable; + + /* + * Get the attribute table for the file. + */ + + attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj); + if (listObj != NULL) { + Tcl_IncrRefCount(listObj); + } + + if (attrTable != NULL) { + /* + * It's a constant attribute table, so use T_GIFO. + */ + + Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, NULL); + int result; + + result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT, + indexPtr); + TclDecrRefCount(tmpObj); + if (listObj != NULL) { + TclDecrRefCount(listObj); + } + return result; + } else if (listObj != NULL) { + /* + * It's a non-constant attribute list, so do a literal search. + */ + + int i, objc; + Tcl_Obj **objv; + + if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) { + TclDecrRefCount(listObj); + return TCL_ERROR; + } + for (i=0 ; i<objc ; i++) { + if (!strcmp(attributeName, TclGetString(objv[i]))) { + TclDecrRefCount(listObj); + *indexPtr = i; + return TCL_OK; + } + } + TclDecrRefCount(listObj); + return TCL_ERROR; + } else { + return TCL_ERROR; + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_FSFileAttrsGet -- * * This procedure implements read access for the hookable 'file @@ -2951,8 +3028,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, return -1; } - if (TclCrossFilesystemCopy(interp, pathPtr, - copyToPtr) == TCL_OK) { + if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) { Tcl_LoadHandle newLoadHandle = NULL; ClientData newClientData = NULL; Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL; @@ -2969,9 +3045,13 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, * we just do this directly, like this: */ + int index; Tcl_Obj* perm = Tcl_NewStringObj("0700",-1); Tcl_IncrRefCount(perm); - Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm); + if (TclFSFileAttrIndex(copyToPtr, "-permissions", + &index) == TCL_OK) { + Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm); + } Tcl_DecrRefCount(perm); #endif diff --git a/generic/tclInt.h b/generic/tclInt.h index 0338e3f..0f88767 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.210 2005/01/05 10:31:02 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.211 2005/01/14 14:16:52 dkf Exp $ */ #ifndef _TCLINT @@ -1843,6 +1843,8 @@ MODULE_SCOPE void TclFinalizeAsync _ANSI_ARGS_((void)); MODULE_SCOPE void TclFinalizeSynchronization _ANSI_ARGS_((void)); MODULE_SCOPE void TclFinalizeLock _ANSI_ARGS_((void)); MODULE_SCOPE void TclFinalizeThreadData _ANSI_ARGS_((void)); +MODULE_SCOPE int TclFSFileAttrIndex _ANSI_ARGS_((Tcl_Obj *pathPtr, + CONST char *attributeName, int *indexPtr)); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp)); MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, |