tclfilename.c

tcl是工具命令语言

/* 
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen
 *	native and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.40 2003/01/09 10:01:59 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/* 
 * This define is used to activate Tcl's interpretation of Unix-style
 * paths (containing forward slashes, '.' and '..') on MacOS.  A 
 * side-effect of this is that some paths become ambiguous.
 */
#define MAC_UNDERSTANDS_UNIX_PATHS

#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
 * The following regular expression matches the root portion of a Macintosh
 * absolute path.  It will match degenerate Unix-style paths, tilde paths,
 * Unix-style paths, and Mac paths.  The various subexpressions in this
 * can be summarised as follows: ^(/..|~user/unix|~user:mac|/unix|mac:dir).
 * The subexpression indices which match the root portions, are as follows:
 * 
 * degenerate unix-style: 2
 * unix-tilde: 5
 * mac-tilde: 7
 * unix-style: 9 (or 10 to cut off the irrelevant header).
 * mac: 12
 * 
 */

#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"

/*
 * The following variables are used to hold precompiled regular expressions
 * for use in filename matching.
 */

typedef struct ThreadSpecificData {
    int initialized;
    Tcl_Obj *macRootPatternPtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

static void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));
static void		FileNameInit _ANSI_ARGS_((void));

#endif

/*
 * The following variable is set in the TclPlatformInit call to one
 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
 */

TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;

/*
 * Prototypes for local procedures defined in this file:
 */

static CONST char *	DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *user, Tcl_DString *resultPtr));
static CONST char *	ExtractWinRoot _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *resultPtr, int offset, 
			    Tcl_PathType *typePtr));
static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
			    char *match));
static Tcl_Obj*		SplitMacPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj*		SplitWinPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj*		SplitUnixPath _ANSI_ARGS_((CONST char *path));
#ifdef MAC_UNDERSTANDS_UNIX_PATHS

/*
 *----------------------------------------------------------------------
 *
 * FileNameInit --
 *
 *	This procedure initializes the patterns used by this module.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Compiles the regular expressions.
 *
 *----------------------------------------------------------------------
 */

static void
FileNameInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
	Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FileNameCleanup --
 *
 *	This procedure is a Tcl_ExitProc used to clean up the static
 *	data structures used in this file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deallocates storage used by the procedures in this file.
 *
 *----------------------------------------------------------------------
 */

static void
FileNameCleanup(clientData)
    ClientData clientData;	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
    tsdPtr->initialized = 0;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
 *
 *	Matches the root portion of a Windows path and appends it
 *	to the specified Tcl_DString.
 *	
 * Results:
 *	Returns the position in the path immediately after the root
 *	including any trailing slashes.
 *	Appends a cleaned up version of the root to the Tcl_DString
 *	at the specified offest.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

static CONST char *
ExtractWinRoot(path, resultPtr, offset, typePtr)
    CONST char *path;		/* Path to parse. */
    Tcl_DString *resultPtr;	/* Buffer to hold result. */
    int offset;			/* Offset in buffer where result should be
				 * stored. */
    Tcl_PathType *typePtr;	/* Where to store pathType result */
{
    if (path[0] == '/' || path[0] == '\\') {
	/* Might be a UNC or Vol-Relative path */
	CONST char *host, *share, *tail;
	int hlen, slen;
	if (path[1] != '/' && path[1] != '\\') {
	    Tcl_DStringSetLength(resultPtr, offset);
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[1];
	}
	host = &path[2];

	/* Skip separators */
	while (host[0] == '/' || host[0] == '\\') host++;

	for (hlen = 0; host[hlen];hlen++) {
	    if (host[hlen] == '/' || host[hlen] == '\\')
		break;
	}
	if (host[hlen] == 0 || host[hlen+1] == 0) {
	    /* 
	     * The path given is simply of the form 
	     * '/foo', '//foo', '/////foo' or the same
	     * with backslashes.  If there is exactly
	     * one leading '/' the path is volume relative
	     * (see filename man page).  If there are more
	     * than one, we are simply assuming they
	     * are superfluous and we trim them away.
	     * (An alternative interpretation would
	     * be that it is a host name, but we have
	     * been documented that that is not the case).
	     */
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[2];
	}
	Tcl_DStringSetLength(resultPtr, offset);
	share = &host[hlen];

	/* Skip separators */
	while (share[0] == '/' || share[0] == '\\') share++;

	for (slen = 0; share[slen];slen++) {
	    if (share[slen] == '/' || share[slen] == '\\')
		break;
	}
	Tcl_DStringAppend(resultPtr, "//", 2);
	Tcl_DStringAppend(resultPtr, host, hlen);
	Tcl_DStringAppend(resultPtr, "/", 1);
	Tcl_DStringAppend(resultPtr, share, slen);

	tail = &share[slen];

	/* Skip separators */
	while (tail[0] == '/' || tail[0] == '\\') tail++;

	*typePtr = TCL_PATH_ABSOLUTE;
	return tail;
    } else if (*path && path[1] == ':') {
	/* Might be a drive sep */
	Tcl_DStringSetLength(resultPtr, offset);

	if (path[2] != '/' && path[2] != '\\') {
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    Tcl_DStringAppend(resultPtr, path, 2);
	    return &path[2];
	} else {
	    char *tail = (char*)&path[3];

	    /* Skip separators */
	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) tail++;

	    *typePtr = TCL_PATH_ABSOLUTE;
	    Tcl_DStringAppend(resultPtr, path, 2);
	    Tcl_DStringAppend(resultPtr, "/", 1);

	    return tail;
	}
    } else {
	int abs = 0;
	if (path[0] == 'c' && path[1] == 'o') {
	    if (path[2] == 'm' && path[3] >= '1' && path[3] <= '9') {
		/* May have match for 'com[1-9]:?', which is a serial port */
	        if (path[4] == '\0') {
	            abs = 4;
	        } else if (path [4] == ':' && path[5] == '\0') {
		    abs = 5;
	        }
	    } else if (path[2] == 'n' && path[3] == '\0') {
		/* Have match for 'con' */
		abs = 3;
	    }
	} else if (path[0] == 'l' && path[1] == 'p' && path[2] == 't') {
	    if (path[3] >= '1' && path[3] <= '9') {
		/* May have match for 'lpt[1-9]:?' */
		if (path[4] == '\0') {
		    abs = 4;
		} else if (path [4] == ':' && path[5] == '\0') {
		    abs = 5;
		}
	    }
	} else if (path[0] == 'p' && path[1] == 'r' 
		   && path[2] == 'n' && path[3] == '\0') {
	    /* Have match for 'prn' */
	    abs = 3;
	} else if (path[0] == 'n' && path[1] == 'u' 
		   && path[2] == 'l' && path[3] == '\0') {
	    /* Have match for 'nul' */
	    abs = 3;
	} else if (path[0] == 'a' && path[1] == 'u' 
		   && path[2] == 'x' && path[3] == '\0') {
	    /* Have match for 'aux' */
	    abs = 3;
	}
	if (abs != 0) {
	    *typePtr = TCL_PATH_ABSOLUTE;
	    Tcl_DStringSetLength(resultPtr, offset);
	    Tcl_DStringAppend(resultPtr, path, abs);
	    return path + abs;
	}
    }
    /* Anything else is treated as relative */
    *typePtr = TCL_PATH_RELATIVE;
    return path;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetPathType --
 *
 *	Determines whether a given path is relative to the current
 *	directory, relative to the current volume, or absolute.
 *	
 *	The objectified Tcl_FSGetPathType should be used in
 *	preference to this function (as you can see below, this
 *	is just a wrapper around that other function).
 *
 * Results:
 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *	TCL_PATH_VOLUME_RELATIVE.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
Tcl_GetPathType(path)
    CONST char *path;
{
    Tcl_PathType type;
    Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
    Tcl_IncrRefCount(tempObj);
    type = Tcl_FSGetPathType(tempObj);
    Tcl_DecrRefCount(tempObj);
    return type;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetNativePathType --
 *
 *	Determines whether a given path is relative to the current
 *	directory, relative to the current volume, or absolute, but
 *	ONLY FOR THE NATIVE FILESYSTEM. This function is called from
 *	tclIOUtil.c (but needs to be here due to its dependence on
 *	static variables/functions in this file).  The exported
 *	function Tcl_FSGetPathType should be used by extensions.
 *
 * Results:
 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *	TCL_PATH_VOLUME_RELATIVE.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
    Tcl_Obj *pathObjPtr;
    int *driveNameLengthPtr;
    Tcl_Obj **driveNameRef;
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    int pathLen;
    char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
    
    if (path[0] == '~') {
	/* 
	 * This case is common to all platforms.
	 * Paths that begin with ~ are absolute.
	 */
	if (driveNameLengthPtr != NULL) {
	    char *end = path + 1;
	    while ((*end != '\0') && (*end != '/')) {
		end++;
	    }
	    *driveNameLengthPtr = end - path;
	}
    } else {
	switch (tclPlatform) {
	    case TCL_PLATFORM_UNIX: {
		char *origPath = path;
	        
		/*
		 * Paths that begin with / are absolute.
		 */

#ifdef __QNX__
		/*
		 * Check for QNX //<node id> prefix
		 */
		if (*path && (pathLen > 3) && (path[0] == '/') 
		  && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
		    path += 3;
		    while (isdigit(UCHAR(*path))) {
			++path;
		    }
		}
#endif
		if (path[0] == '/') {
		    if (driveNameLengthPtr != NULL) {
			/* 
			 * We need this addition in case the QNX code 
			 * was used 
			 */
			*driveNameLengthPtr = (1 + path - origPath);
		    }
		} else {
		    type = TCL_PATH_RELATIVE;
		}
		break;
	    }
	    case TCL_PLATFORM_MAC:
		if (path[0] == ':') {
		    type = TCL_PATH_RELATIVE;
		} else {
#ifdef MAC_UNDERSTANDS_UNIX_PATHS
		    ThreadSpecificData *tsdPtr;
		    Tcl_RegExp re;

		    tsdPtr = TCL_TSD_INIT(&dataKey);

		    /*
		     * Since we have eliminated the easy cases, use the
		     * root pattern to look for the other types.
		     */

		    FileNameInit();
		    re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
			    REG_ADVANCED);

		    if (!Tcl_RegExpExec(NULL, re, path, path)) {
			type = TCL_PATH_RELATIVE;
		    } else {
			CONST char *root, *end;
			Tcl_RegExpRange(re, 2, &root, &end);
			if (root != NULL) {
			    type = TCL_PATH_RELATIVE;
			} else {
			    if (driveNameLengthPtr != NULL) {
				Tcl_RegExpRange(re, 0, &root, &end);
				*driveNameLengthPtr = end - root;
			    }
			    if (driveNameRef != NULL) {
				if (*root == '/') {
				    char *c;
				    int gotColon = 0;
				    *driveNameRef = Tcl_NewStringObj(root + 1,
					    end - root -1);
				    c = Tcl_GetString(*driveNameRef);
				    while (*c != '\0') {
					if (*c == '/') {
					    gotColon++;
					    *c = ':';
					}
					c++;
				    }
				    /* 
				     * If there is no colon, we have just a
				     * volume name so we must add a colon so
				     * it is an absolute path.
				     */
				    if (gotColon == 0) {
				        Tcl_AppendToObj(*driveNameRef, ":", 1);
				    } else if ((gotColon > 1) &&
					    (*(c-1) == ':')) {
					/* We have an extra colon */
				        Tcl_SetObjLength(*driveNameRef, 
					  c - Tcl_GetString(*driveNameRef) - 1);
				    }
				}
			    }
			}
		    }
#else
		    if (path[0] == '~') {
		    } else if (path[0] == ':') {
			type = TCL_PATH_RELATIVE;
		    } else {
			char *colonPos = strchr(path,':');
			if (colonPos == NULL) {
			    type = TCL_PATH_RELATIVE;
			} else {
			}
		    }
		    if (type == TCL_PATH_ABSOLUTE) {
			if (driveNameLengthPtr != NULL) {
			    *driveNameLengthPtr = strlen(path);
			}
		    }
#endif
		}
		break;
	    
	    case TCL_PLATFORM_WINDOWS: {
		Tcl_DString ds;
		CONST char *rootEnd;
		
		Tcl_DStringInit(&ds);
		rootEnd = ExtractWinRoot(path, &ds, 0, &type);
		if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
		    *driveNameLengthPtr = rootEnd - path;
		    if (driveNameRef != NULL) {
			*driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
				Tcl_DStringLength(&ds));
			Tcl_IncrRefCount(*driveNameRef);
		    }
		}
		Tcl_DStringFree(&ds);
		break;
	    }