diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 88 |
1 files changed, 84 insertions, 4 deletions
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 |