/*
 * This file is obsolete and should be removed (some day) from CVS.
 */
/*
 * t4transfer.cpp --
 *
 *	Implementation of the T4Graph command to transfer a storage from
 *	one interpreter to another.
 *
 *	Authors: Jacob Levy and Jean-Claude Wippler.
 *		 jyl@best.com	jcw@equi4.com
 *
 * Copyright (c) 2000-2001, JYL Software Inc.
 * 
 * Permission is hereby granted, free of charge, to any person obtaining
 * a copy of this software and associated documentation files (the
 * "Software"), to deal in the Software without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Software, and to
 * permit persons to whom the Software is furnished to do so, subject to
 * the following conditions:
 * 
 * The above copyright notice and this permission notice shall be
 * included in all copies or substantial portions of the Software.
 * 
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
 * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
 * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
 * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE, EVEN IF
 * JYL SOFTWARE INC. IS MADE AWARE OF THE POSSIBILITY OF SUCH DAMAGE.
 */

#include "t4graph.h"

/*
 * TransferStorageProc --
 *
 *	This procedure is called when "tgraph::transfer" is invoked.
 *	Syntax:
 *		tgraph::transfer storage interp-path
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The interpreter identified by interp-path now has access to the
 *	given storage.
 */

int
TransferStorageProc(ClientData cd, Tcl_Interp *interp, int objc,
		    Tcl_Obj *CONST objv[])
{
    T4Storage *sp;
    Tcl_Interp *slave;
    Tcl_HashEntry *ep;
    Tcl_HashTable *tp;
    char buf[128];

    /*
     * Check that there are exactly two arguments:
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, (char *) "storage interp-path");
	return TCL_ERROR;
    }

    /*
     * Convert from the storage command name to the storage itself.
     */

    tp = (Tcl_HashTable *) Tcl_GetAssocData(interp, T4_ASSOCKEY, NULL);
    if (tp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "internal error: invalid storage hash",
			       " table", NULL);
	return TCL_ERROR;
    }

    ep = Tcl_FindHashEntry(tp, Tcl_GetString(objv[1]));
    if (ep == NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       Tcl_GetString(objv[0]),
			       ": could not transfer storage \"",
			       Tcl_GetString(objv[1]),
			       "\" to interp \"",
			       Tcl_GetString(objv[2]),
			       "\"", (char *) NULL);
	return TCL_ERROR;
    }
    sp = (T4Storage *) Tcl_GetHashValue(ep);

    /*
     * Find the slave interpreter.
     */

    slave = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
    if (slave == NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       Tcl_GetString(objv[0]),
			       ": could not find interpreter \"",
			       Tcl_GetString(objv[2]),
			       "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Make the storage accessible in the other interpreter.
     */

    if (MakeStorageCommand(slave, sp) != TCL_OK) {
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       Tcl_GetString(objv[0]),
			       ": could not transfer storage \"",
			       Tcl_GetString(objv[1]),
			       "\" to interpreter \"",
			       Tcl_GetString(objv[2]),
			       "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Make the storage inaccessible in this interpreter.
     */

    sp->RemoveAllExportedObjects(interp);
    sp->RemoveAllCallbacks();
    DeleteStorageCommand(interp, sp);

    /*
     * Delete the namespace for this storage in this interpreter.
     */

    sprintf(buf, "namespace delete ::tgraph::%s", sp->GetName());
    Tcl_Eval(interp, buf);

    fprintf(stderr, "Before set assoc interp\n");

    /*
     * Associate the slave interpreter with the storage.
     */

    sp->SetAssociatedInterpreter(slave);

    /*
     * Success.
     */

    Tcl_ResetResult(interp);
    
    return TCL_OK;
}