tclmacfcmd.c

tcl是工具命令语言

{
    OSErr err;
    FSSpec fileSpec;
    FInfo finfo;
    CONST char *native;

    native=Tcl_FSGetNativePath(fileName);
    err = FSpLLocationFromPath(strlen(native),
	    native, &fileSpec);
    
    if (err == noErr) {
    	err = FSpGetFInfo(&fileSpec, &finfo);
    }
    
    if (err == noErr) {
    	switch (objIndex) {
    	    case MAC_CREATOR_ATTRIBUTE:
    	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
    	    		&finfo.fdCreator) != TCL_OK) {
    	    	    return TCL_ERROR;
    	    	}
    	    	break;
    	    case MAC_HIDDEN_ATTRIBUTE: {
    	    	int hidden;
    	    	
    	    	if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
    	    		!= TCL_OK) {
    	    	    return TCL_ERROR;
    	    	}
    	    	if (hidden) {
    	    	    finfo.fdFlags |= kIsInvisible;
    	    	} else {
    	    	    finfo.fdFlags &= ~kIsInvisible;
    	    	}
    	    	break;
    	    }
    	    case MAC_TYPE_ATTRIBUTE:
    	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
    	    		&finfo.fdType) != TCL_OK) {
    	    	    return TCL_ERROR;
    	    	}
    	    	break;
    	}
    	err = FSpSetFInfo(&fileSpec, &finfo);
    } else if (err == fnfErr) {
    	long dirID;
    	Boolean isDirectory = 0;
    	
    	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
    	if ((err == noErr) && isDirectory) {
    	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    	    Tcl_AppendStringsToObj(resultPtr, "cannot set ",
    	    	    tclpFileAttrStrings[objIndex], ": \"",
    	    	    Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
    	    return TCL_ERROR;
    	}
    }
    
    if (err != noErr) {
    	errno = TclMacOSErrorToPosixError(err);
    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
    		"could not read \"", Tcl_GetString(fileName), "\": ",
    		Tcl_PosixError(interp), (char *) NULL);
    	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetFileReadOnly --
 *
 *	Sets the file to be read-only according to the Boolean value
 *	given by hiddenPtr.
 *
 * Results:
 *	Returns a standard TCL error.
 *
 * Side effects:
 *      The file's attribute is set.
 *      
 *----------------------------------------------------------------------
 */

static int
SetFileReadOnly(
    Tcl_Interp *interp,		/* The interp to report errors with. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,	/* The name of the file (UTF-8). */
    Tcl_Obj *readOnlyPtr)	/* The command line object. */
{
    OSErr err;
    FSSpec fileSpec;
    HParamBlockRec paramBlock;
    int hidden;
    CONST char *native;

    native=Tcl_FSGetNativePath(fileName);
    err = FSpLLocationFromPath(strlen(native),
	    native, &fileSpec);
    
    if (err == noErr) {
    	if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
    	    return TCL_ERROR;
    	}
    
    	paramBlock.fileParam.ioCompletion = NULL;
    	paramBlock.fileParam.ioNamePtr = fileSpec.name;
    	paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
    	paramBlock.fileParam.ioDirID = fileSpec.parID;
    	if (hidden) {
    	    err = PBHSetFLock(&paramBlock, 0);
    	} else {
    	    err = PBHRstFLock(&paramBlock, 0);
    	}
    }
    
    if (err == fnfErr) {
    	long dirID;
    	Boolean isDirectory = 0;
    	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
    	if ((err == noErr) && isDirectory) {
    	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
    	    	    "cannot set a directory to read-only when File Sharing is turned off",
    	    	    (char *) NULL);
    	    return TCL_ERROR;
    	} else {
    	    err = fnfErr;
    	}
    }
    
    if (err != noErr) {
    	errno = TclMacOSErrorToPosixError(err);
    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
    		"could not read \"", Tcl_GetString(fileName), "\": ",
    		Tcl_PosixError(interp), (char *) NULL);
    	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjListVolumes --
 *
 *	Lists the currently mounted volumes
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
TclpObjListVolumes(void)
{
    HParamBlockRec pb;
    Str255 name;
    OSErr theError = noErr;
    Tcl_Obj *resultPtr, *elemPtr;
    short volIndex = 1;
    Tcl_DString dstr;

    resultPtr = Tcl_NewObj();
        
    /*
     * We use two facts:
     * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
     * the HParamBlockRec.  They run through the integers contiguously, 
     * starting at 1.  
     * 2) PBHGetVInfoSync returns an error when you ask for a volume index
     * that does not exist.
     * 
     */
        
    while ( 1 ) {
        pb.volumeParam.ioNamePtr = (StringPtr) &name;
        pb.volumeParam.ioVolIndex = volIndex;
                
        theError = PBHGetVInfoSync(&pb);

        if ( theError != noErr ) {
            break;
        }
        
        Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
        elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
		Tcl_DStringLength(&dstr));
        Tcl_AppendToObj(elemPtr, ":", 1);
        Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
        
        Tcl_DStringFree(&dstr);
                
        volIndex++;             
    }

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	This function scans through a path specification and replaces
 *	it, in place, with a normalized version.  On MacOS, this means
 *	resolving all aliases present in the path and replacing the head of
 *	pathPtr with the absolute case-sensitive path to the last file or
 *	directory that could be validated in the path.
 *
 * Results:
 *	The new 'nextCheckpoint' value, giving as far as we could
 *	understand in the path.
 *
 * Side effects:
 *	The pathPtr string, which must contain a valid path, is
 *	possibly modified in place.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
    int nextCheckpoint;
{
    #define MAXMACFILENAMELEN 31  /* assumed to be < sizeof(StrFileName) */
 
    StrFileName fileName;
    StringPtr fileNamePtr;
    int fileNameLen,newPathLen;
    Handle newPathHandle;
    OSErr err;
    short vRefNum;
    long dirID;
    Boolean isDirectory;
    Boolean wasAlias=FALSE;
    FSSpec fileSpec, lastFileSpec;
    
    Tcl_DString nativeds;

    char cur;
    int firstCheckpoint=nextCheckpoint, lastCheckpoint;
    int origPathLen;
    char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
    
    {
	int currDirValid=0;    
	/*
	 * check if substring to first ':' after initial
	 * nextCheckpoint is a valid relative or absolute
	 * path to a directory, if not we return without
	 * normalizing anything
	 */
	
	while (1) {
	    cur = path[nextCheckpoint];
	    if (cur == ':' || cur == 0) {
		if (cur == ':') { 
		    /* jump over separator */
		    nextCheckpoint++; cur = path[nextCheckpoint]; 
		} 
		Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
		err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds), 
					  Tcl_DStringValue(&nativeds), 
					  &fileSpec);
		Tcl_DStringFree(&nativeds);
		if (err == noErr) {
			lastFileSpec=fileSpec;
			err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
				       &wasAlias);
			if (err == noErr) {
		    err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
		    currDirValid = ((err == noErr) && isDirectory);
		    vRefNum = fileSpec.vRefNum;
		    }
		}
		break;
	    }
	    nextCheckpoint++;
	}
	
	if(!currDirValid) {
	    /* can't determine root dir, bail out */
	    return firstCheckpoint; 
	}
    }
	
    /*
     * Now vRefNum and dirID point to a valid
     * directory, so walk the rest of the path
     * ( code adapted from FSpLocationFromPath() )
     */

    lastCheckpoint=nextCheckpoint;
    while (1) {
	cur = path[nextCheckpoint];
	if (cur == ':' || cur == 0) {
	    fileNameLen=nextCheckpoint-lastCheckpoint;
	    fileNamePtr=fileName;
	    if(fileNameLen==0) {
		if (cur == ':') {
		    /*
		     * special case for empty dirname i.e. encountered
		     * a '::' path component: get parent dir of currDir
		     */
		    fileName[0]=2;
		    strcpy((char *) fileName + 1, "::");
		    lastCheckpoint--;
		} else {
		    /*
		     * empty filename, i.e. want FSSpec for currDir
		     */
		    fileNamePtr=NULL;
		}
	    } else {
		Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
					 fileNameLen,&nativeds);
		fileNameLen=Tcl_DStringLength(&nativeds);
		if(fileNameLen > MAXMACFILENAMELEN) { 
		    err = bdNamErr;
		} else {
		fileName[0]=fileNameLen;
		strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), 
			fileNameLen);
		}
		Tcl_DStringFree(&nativeds);
	    }
	    if(err == noErr)
	    err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
	    if(err != noErr) {
		if(err != fnfErr) {
		    /*
		     * this can occur if trying to get parent of a root
		     * volume via '::' or when using an illegal
		     * filename; revert to last checkpoint and stop
		     * processing path further
		     */
		    err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
		    if(err != noErr) {
			/* should never happen, bail out */
			return firstCheckpoint; 
		    }
		    nextCheckpoint=lastCheckpoint;
		    cur = path[lastCheckpoint];
		}
    		break; /* arrived at nonexistent file or dir */
	    } else {
		/* fileSpec could point to an alias, resolve it */
		lastFileSpec=fileSpec;
		err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
				       &wasAlias);
		if (err != noErr || !isDirectory) {
		    break; /* fileSpec doesn't point to a dir */
		}
	    }
	    if (cur == 0) break; /* arrived at end of path */
	    
	    /* fileSpec points to possibly nonexisting subdirectory; validate */
	    err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
	    if (err != noErr || !isDirectory) {
	        break; /* fileSpec doesn't point to existing dir */
	    }
	    vRefNum = fileSpec.vRefNum;
    	
	    /* found a new valid subdir in path, continue processing path */
	    lastCheckpoint=nextCheckpoint+1;
	}
	wasAlias=FALSE;
	nextCheckpoint++;
    }
    
    if (wasAlias)
    	fileSpec=lastFileSpec;
    
    /*
     * fileSpec now points to a possibly nonexisting file or dir
     *  inside a valid dir; get full path name to it
     */
    
    err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
    if(err != noErr) {
	return firstCheckpoint; /* should not see any errors here, bail out */
    }
    
    HLock(newPathHandle);
    Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
    if (cur != 0) {
	/* not at end, append remaining path */
    	if ( newPathLen==0 || (*(*newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
	    Tcl_DStringAppend(&nativeds, ":" , 1);
	}
	Tcl_DStringAppend(&nativeds, &path[nextCheckpoint], 
			  strlen(&path[nextCheckpoint]));
    }
    DisposeHandle(newPathHandle);
    
    fileNameLen=Tcl_DStringLength(&nativeds);
    Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
    Tcl_DStringFree(&nativeds);
    
    return nextCheckpoint+(fileNameLen-origPathLen);
}