tclwinfile.c

linux系统下的音频通信

/* 
 * tclWinFile.c --
 *
 *      This file contains temporary wrappers around UNIX file handling
 *      functions. These wrappers map the UNIX functions to Win32 HANDLE-style
 *      files, which can be manipulated through the Win32 console redirection
 *      interfaces.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclWinFile.c 1.45 97/10/29 19:08:35
 */

#include "tclWinInt.h"
#include <sys/stat.h>
#include <shlobj.h>

/*
 * The variable below caches the name of the current working directory
 * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
 * NULL means the cache needs to be refreshed.
 */

static char *currentDir =  NULL;


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindExecutable --
 *
 *	This procedure computes the absolute path name of the current
 *	application, given its argv[0] value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The variable tclExecutableName gets filled in with the file
 *	name for the application, if we figured it out.  If we couldn't
 *	figure it out, Tcl_FindExecutable is set to NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FindExecutable(argv0)
    char *argv0;		/* The value of the application's argv[0]. */
{
    Tcl_DString buffer;
    int length;

    Tcl_DStringInit(&buffer);

    if (tclExecutableName != NULL) {
	ckfree(tclExecutableName);
	tclExecutableName = NULL;
    }

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process.
     */

    Tcl_DStringSetLength(&buffer, MAX_PATH+1);
    length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
    if (length > 0) {
	tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
	strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
    }
    Tcl_DStringFree(&buffer);
}

/*
 *----------------------------------------------------------------------
 *
 * TclMatchFiles --
 *
 *	This routine is used by the globbing code to search a
 *	directory for all files which match a given pattern.
 *
 * Results: 
 *	If the tail argument is NULL, then the matching files are
 *	added to the interp->result.  Otherwise, TclDoGlob is called
 *	recursively for each matching subdirectory.  The return value
 *	is a standard Tcl result indicating whether an error occurred
 *	in globbing.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------- */

int
TclMatchFiles(interp, separators, dirPtr, pattern, tail)
    Tcl_Interp *interp;		/* Interpreter to receive results. */
    char *separators;		/* Directory separators to pass to TclDoGlob. */
    Tcl_DString *dirPtr;	/* Contains path to directory to search. */
    char *pattern;		/* Pattern to match against. */
    char *tail;			/* Pointer to end of pattern.  Tail must
				 * point to a location in pattern. */
{
    char drivePattern[4] = "?:\\";
    char *newPattern, *p, *dir, *root, c;
    char *src, *dest;
    int length, matchDotFiles;
    int result = TCL_OK;
    int baseLength = Tcl_DStringLength(dirPtr);
    Tcl_DString buffer;
    DWORD atts, volFlags;
    HANDLE handle;
    WIN32_FIND_DATA data;
    BOOL found;

    /*
     * Convert the path to normalized form since some interfaces only
     * accept backslashes.  Also, ensure that the directory ends with a
     * separator character.
     */

    Tcl_DStringInit(&buffer);
    if (baseLength == 0) {
	Tcl_DStringAppend(&buffer, ".", 1);
    } else {
	Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
		Tcl_DStringLength(dirPtr));
    }
    for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
	if (*p == '/') {
	    *p = '\\';
	}
    }
    p--;
    if (*p != '\\' && *p != ':') {
	Tcl_DStringAppend(&buffer, "\\", 1);
    }
    dir = Tcl_DStringValue(&buffer);
    
    /*
     * First verify that the specified path is actually a directory.
     */

    atts = GetFileAttributes(dir);
    if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }

    /*
     * Next check the volume information for the directory to see whether
     * comparisons should be case sensitive or not.  If the root is null, then
     * we use the root of the current directory.  If the root is just a drive
     * specifier, we use the root directory of the given drive.
     */

    switch (Tcl_GetPathType(dir)) {
	case TCL_PATH_RELATIVE:
	    found = GetVolumeInformation(NULL, NULL, 0, NULL,
		    NULL, &volFlags, NULL, 0);
	    break;
	case TCL_PATH_VOLUME_RELATIVE:
	    if (*dir == '\\') {
		root = NULL;
	    } else {
		root = drivePattern;
		*root = *dir;
	    }
	    found = GetVolumeInformation(root, NULL, 0, NULL,
		    NULL, &volFlags, NULL, 0);
	    break;
	case TCL_PATH_ABSOLUTE:
	    if (dir[1] == ':') {
		root = drivePattern;
		*root = *dir;
		found = GetVolumeInformation(root, NULL, 0, NULL,
			NULL, &volFlags, NULL, 0);
	    } else if (dir[1] == '\\') {
		p = strchr(dir+2, '\\');
		p = strchr(p+1, '\\');
		p++;
		c = *p;
		*p = 0;
		found = GetVolumeInformation(dir, NULL, 0, NULL,
			NULL, &volFlags, NULL, 0);
		*p = c;
	    }
	    break;
    }

    if (!found) {
	Tcl_DStringFree(&buffer);
	TclWinConvertError(GetLastError());
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't read volume information for \"",
		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    
    /*
     * In Windows, although some volumes may support case sensitivity, Windows
     * doesn't honor case.  So in globbing we need to ignore the case
     * of file names.
     */

    length = tail - pattern;
    newPattern = ckalloc(length+1);
    for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
	*dest = (char) tolower(*src);
    }
    *dest = '\0';
    
    /*
     * We need to check all files in the directory, so append a *.*
     * to the path. 
     */


    dir = Tcl_DStringAppend(&buffer, "*.*", 3);

    /*
     * Now open the directory for reading and iterate over the contents.
     */

    handle = FindFirstFile(dir, &data);
    Tcl_DStringFree(&buffer);

    if (handle == INVALID_HANDLE_VALUE) {
	TclWinConvertError(GetLastError());
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't read directory \"",
		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
	ckfree(newPattern);
	return TCL_ERROR;
    }

    /*
     * Clean up the tail pointer.  Leave the tail pointing to the 
     * first character after the path separator or NULL. 
     */

    if (*tail == '\\') {
	tail++;
    }
    if (*tail == '\0') {
	tail = NULL;
    } else {
	tail++;
    }

    /*
     * Check to see if the pattern needs to compare with dot files.
     */

    if ((newPattern[0] == '.')
	    || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
        matchDotFiles = 1;
    } else {
        matchDotFiles = 0;
    }

    /*
     * Now iterate over all of the files in the directory.
     */

    Tcl_DStringInit(&buffer);
    for (found = 1; found; found = FindNextFile(handle, &data)) {
	char *matchResult;

	/*
	 * Ignore hidden files.
	 */

	if (!matchDotFiles && (data.cFileName[0] == '.')) {
	    continue;
	}

	/*
	 * Check to see if the file matches the pattern.  We need to convert
	 * the file name to lower case for comparison purposes.  Note that we
	 * are ignoring the case sensitivity flag because Windows doesn't honor
	 * case even if the volume is case sensitive.  If the volume also
	 * doesn't preserve case, then we return the lower case form of the
	 * name, otherwise we return the system form.
	 */

	matchResult = NULL;
	Tcl_DStringSetLength(&buffer, 0);
	Tcl_DStringAppend(&buffer, data.cFileName, -1);
	for (p = buffer.string; *p != '\0'; p++) {
	    *p = (char) tolower(*p);
	}
	if (Tcl_StringMatch(buffer.string, newPattern)) {
	    if (volFlags & FS_CASE_IS_PRESERVED) {
		matchResult = data.cFileName;
	    } else {
		matchResult = buffer.string;
	    }	
	}

	if (matchResult == NULL) {
	    continue;
	}

	/*
	 * If the file matches, then we need to process the remainder of the
	 * path.  If there are more characters to process, then ensure matching
	 * files are directories and call TclDoGlob. Otherwise, just add the
	 * file to the result.
	 */

	Tcl_DStringSetLength(dirPtr, baseLength);
	Tcl_DStringAppend(dirPtr, matchResult, -1);
	if (tail == NULL) {
	    Tcl_AppendElement(interp, dirPtr->string);
	} else {
	    atts = GetFileAttributes(dirPtr->string);
	    if (atts & FILE_ATTRIBUTE_DIRECTORY) {
		Tcl_DStringAppend(dirPtr, "/", 1);
		result = TclDoGlob(interp, separators, dirPtr, tail);
		if (result != TCL_OK) {
		    break;