tclfcmd.c

linux系统下的音频通信

/*
 * tclFCmd.c
 *
 *      This file implements the generic portion of file manipulation 
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996-1997 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: @(#) tclFCmd.c 1.17 97/05/14 13:23:13
 */

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

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

static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
			    char *source, char *dest, int copyFlag,
			    int force));
static char *		FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
			    char *path, Tcl_DString *bufferPtr));
static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv, int copyFlag));
static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv, int *forcePtr));

/*
 *---------------------------------------------------------------------------
 *
 * TclFileRenameCmd
 *
 *	This procedure implements the "rename" subcommand of the "file"
 *      command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements rename functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileRenameCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, argc, argv, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileCopyCmd
 *
 *	This procedure implements the "copy" subcommand of the "file"
 *	command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements copy functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileCopyCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, argc, argv, 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * FileCopyRename --
 *
 *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
 *	See comments for those procedures.
 *
 * Results:
 *	See above.
 *
 * Side effects:
 *	See above.
 *
 *---------------------------------------------------------------------------
 */

static int
FileCopyRename(interp, argc, argv, copyFlag)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,
				 * rename them. */
{
    int i, result, force;
    struct stat statBuf; 
    Tcl_DString targetBuffer;
    char *target;

    i = FileForceOption(interp, argc - 2, argv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i += 2;
    if ((argc - i) < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ", argv[1], " ?options? source ?source ...? target\"", 
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * If target doesn't exist or isn't a directory, try the copy/rename.
     * More than 2 arguments is only valid if the target is an existing
     * directory.
     */

    target = Tcl_TranslateFileName(interp, argv[argc - 1], &targetBuffer);
    if (target == NULL) {
	return TCL_ERROR;
    }

    result = TCL_OK;

    /*
     * Call TclStat() so that if target is a symlink that points to a
     * directory we will put the sources in that directory instead of
     * overwriting the symlink.
     */

    if ((TclStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((argc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    Tcl_AppendResult(interp, "error ",
		    ((copyFlag) ? "copying" : "renaming"), ": target \"",
		    argv[argc - 1], "\" is not a directory", (char *) NULL);
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(argv[i+1]),
	     * pass the original argument down, so if there's an error, the
	     * error message will reflect the original arguments.
	     */

	    result = CopyRenameOneFile(interp, argv[i], argv[i + 1], copyFlag,
		    force);
	}
	Tcl_DStringFree(&targetBuffer);
	return result;
    }
    
    /*
     * Move each source file into target directory.  Extract the basename
     * from each source, and append it to the end of the target path.
     */
    
    for ( ; i < argc - 1; i++) {
	char *jargv[2];
	char *source, *newFileName;
	Tcl_DString sourceBuffer, newFileNameBuffer;

	source = FileBasename(interp, argv[i], &sourceBuffer);
	if (source == NULL) {
	    result = TCL_ERROR;
	    break;
	}
	jargv[0] = argv[argc - 1];
	jargv[1] = source;
	Tcl_DStringInit(&newFileNameBuffer);
	newFileName = Tcl_JoinPath(2, jargv, &newFileNameBuffer);
	result = CopyRenameOneFile(interp, argv[i], newFileName, copyFlag,
		force);
	Tcl_DStringFree(&sourceBuffer);
	Tcl_DStringFree(&newFileNameBuffer);

	if (result == TCL_ERROR) {
	    break;
	}
    }
    Tcl_DStringFree(&targetBuffer);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileMakeDirsCmd
 *
 *	This procedure implements the "mkdir" subcommand of the "file"
 *      command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements mkdir functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
TclFileMakeDirsCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int argc;			/* Number of arguments */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_DString nameBuffer, targetBuffer;
    char *errfile;
    int result, i, j, pargc;
    char **pargv;
    struct stat statBuf;

    pargv = NULL;
    errfile = NULL;
    Tcl_DStringInit(&nameBuffer);
    Tcl_DStringInit(&targetBuffer);

    result = TCL_OK;
    for (i = 2; i < argc; i++) {
	char *name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
	if (name == NULL) {
	    result = TCL_ERROR;
	    break;
	}

	Tcl_SplitPath(name, &pargc, &pargv);
	if (pargc == 0) {
	    errno = ENOENT;
	    errfile = argv[i];
	    break;
	}
	for (j = 0; j < pargc; j++) {
	    char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer);

	    /*
	     * Call TclStat() so that if target is a symlink that points
	     * to a directory we will create subdirectories in that
	     * directory.
	     */

	    if (TclStat(target, &statBuf) == 0) {
		if (!S_ISDIR(statBuf.st_mode)) {
		    errno = EEXIST;
		    errfile = target;
		    goto done;
		}
	    } else if ((errno != ENOENT)
		    || (TclpCreateDirectory(target) != TCL_OK)) {
		errfile = target;
		goto done;
	    }
	    Tcl_DStringFree(&targetBuffer);
	}
	ckfree((char *) pargv);
	pargv = NULL;
	Tcl_DStringFree(&nameBuffer);
    }
	
    done:
    if (errfile != NULL) {
	Tcl_AppendResult(interp, "can't create directory \"",
		errfile, "\": ", Tcl_PosixError(interp), (char *) NULL);
	result = TCL_ERROR;
    }

    Tcl_DStringFree(&nameBuffer);
    Tcl_DStringFree(&targetBuffer);
    if (pargv != NULL) {
	ckfree((char *) pargv);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileDeleteCmd
 *
 *	This procedure implements the "delete" subcommand of the "file"
 *      command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileDeleteCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int argc;			/* Number of arguments */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_DString nameBuffer, errorBuffer;
    int i, force, result;
    char *errfile;
    
    i = FileForceOption(interp, argc - 2, argv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i += 2;
    if ((argc - i) < 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ", argv[1], " ?options? file ?file ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    errfile = NULL;
    result = TCL_OK;
    Tcl_DStringInit(&errorBuffer);
    Tcl_DStringInit(&nameBuffer);

    for ( ; i < argc; i++) {
	struct stat statBuf;
	char *name;

	errfile = argv[i];
	Tcl_DStringSetLength(&nameBuffer, 0);
	name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
	if (name == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}

	/*
	 * Call lstat() to get info so can delete symbolic link itself.
	 */

	if (lstat(name, &statBuf) != 0) {
	    /*
	     * Trying to delete a file that does not exist is not
	     * considered an error, just a no-op
	     */

	    if (errno != ENOENT) {
		result = TCL_ERROR;
	    }
	} else if (S_ISDIR(statBuf.st_mode)) {
	    result = TclpRemoveDirectory(name, force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    Tcl_AppendResult(interp, "error deleting \"", argv[i],
			    "\": directory not empty", (char *) NULL);
		    Tcl_PosixError(interp);
		    goto done;
		}

		/* 
		 * If possible, use the untranslated name for the file.
		 */
		 
		errfile = Tcl_DStringValue(&errorBuffer);
		if (strcmp(name, errfile) == 0) {
		    errfile = argv[i];
		}
	    }
	} else {
	    result = TclpDeleteFile(name);
	}
	
	if (result == TCL_ERROR) {
	    break;
	}
    }
    if (result != TCL_OK) {
	Tcl_AppendResult(interp, "error deleting \"", errfile,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
    } 
    done:
    Tcl_DStringFree(&errorBuffer);
    Tcl_DStringFree(&nameBuffer);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * CopyRenameOneFile
 *
 *	Copies or renames specified source file or directory hierarchy
 *	to the specified target.  
 *
 * Results:
 *	A standard Tcl result.
 *