path: root/comm/OLD/TclAgent.cc

/*
 *	The Unix Channel
 *
 *	by Michel Beaudouin-Lafon
 *
 *	Copyright 1990-1993
 *	Laboratoire de Recherche en Informatique (LRI)
 *
 *	An extension to Tcl for using agents
 *
 *	$Id$
 *	$CurLog$
 */

#include "TextStream.h"
#include "ccu/String.h"
#include "TkMultiplexer.h"
#include <stdio.h>
#include <string.h>

extern "C" {
#include <tcl.h>
}
#undef const

class TclAgent : public UchTextService {
public:
		TclAgent (Tcl_Interp*, const char*);
		~TclAgent ();
	
	void	SetGotServerCmd (const char*);
	void	SetLostServerCmd (const char*);
	void	SetAbandonCmd (const char*);
	void	SetClosingCmd (const char*);
inline	const char*	GetName () const	{ return tclName; }

	
protected:
	CcuString	tclName;
	Tcl_Interp*	interp;
	CcuString		gotServerCmd;
	CcuString		lostServerCmd;
	CcuString		abandonCmd;

	Tcl_CmdBuf	buffer;
	
	cmd_res	Execute (const UchTextLine&);
	void	LostServer ();
	void	GotServer ();
	void	AbandonRestart ();
};


TclAgent :: TclAgent (Tcl_Interp* i, const char* nm)
: UchTextService (),
  tclName (nm),
  gotServerCmd (),
  lostServerCmd (),
  abandonCmd ()
{
	interp = i;	
	buffer = Tcl_CreateCmdBuf ();
}

void
TclAgent :: SetGotServerCmd (const char* cmd)
{
	gotServerCmd = cmd;
}

void
TclAgent :: SetLostServerCmd (const char* cmd)
{
	lostServerCmd = cmd;
}

void
TclAgent :: SetAbandonCmd (const char* cmd)
{
	abandonCmd = cmd;
}

TclAgent :: ~TclAgent ()
{
	Tcl_DeleteCmdBuf (buffer);
}

/*
 *	eval the following command:
 *		catch { agentname.cmd args }
 *	where cmd is the first word of the line, i.e. the reply sent by the agent
 *	and agentname the name of the agent as defined with the 'agent' command.
 *	catch allows to handle undefined handlers for replies gracefully.
 */
UchTextStream::cmd_res
TclAgent :: Execute (const UchTextLine& line)
{
	char buf [1024];
	char* p;
	
	
	sprintf (buf, "catch { %s.%s ", tclName, (const char*) (line [0]));
	p = buf + strlen (buf);
	
	for (int i = 1; i < line.NumWords (); i++) {
		if (line[i].IsInt ())
			sprintf (p, "%d ", int (line[i]));
		else
			sprintf (p, "{%s} ", (const char*) (line[i]));
		p += strlen (p);
	}
	strcpy (p, "}");
	
	if (Tcl_GlobalEval (interp, buf) == TCL_OK)
		return isCmdOk;
	return isCmdError;
}

void
TclAgent :: LostServer ()
{
	UchTextService::LostServer ();
	
	if (lostServerCmd)
		Tcl_GlobalEval (interp, (char*)(const char*)lostServerCmd);
}

void
TclAgent :: GotServer ()
{
	UchTextService::GotServer ();

	if (gotServerCmd)
		Tcl_GlobalEval (interp, (char*)(const char*)gotServerCmd);
}

void
TclAgent :: AbandonRestart ()
{
	if (abandonCmd)
		Tcl_GlobalEval (interp, (char*)(const char*) abandonCmd);
	
	Tcl_DeleteCommand (interp, (char*)(const char*) tclName);
	CloseNow ();
}

//---------------- Tcl commands

/*
 *	command to send requests to an agent and to operate an agent
 *		agentname send request args...
 *		agentname status
 *			returns unavailable, error, running, lost
 *		agentname close
 *		agentname closenow
 */
int
AgentCmd (ClientData data, Tcl_Interp* interp, int argc, char* argv [])
{
	TclAgent*	agent = (TclAgent*) data;
	
	/* check arguments: at least two */
	if (argc < 2) {
		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
			" status | close | closenow | send request [args ...]\"", (char *) NULL);
		return TCL_ERROR;
	}
	
	const char* cmd = argv [1];
	
	/* send command */
	if (strcmp (cmd, "send") == 0) {
		if (argc < 3) {
			Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
				" send request [args ...]\"", (char *) NULL);
			return TCL_ERROR;
		}
	
		for (int i = 2; i < argc; i++) {
			agent->Append (argv [i]);
			if (i < argc -1)
				agent->Append (" ");
		}
		agent->Send ("\n");
		return TCL_OK;
	}
	
	/* simple commands */
	if (argc != 2) {
		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
			" status | close | closenow | send request [args ...]\"", (char *) NULL);
		return TCL_ERROR;
	}
	
	if (strcmp (cmd, "status") == 0) {
		switch (agent->GetStatus ()) {
		case UchTextService::isUnavailable:
			sprintf (interp->result, "unavailable");
			break;
		case UchTextService::isError:
			sprintf (interp->result, "error");
			break;
		case UchTextService::isRunning:
			sprintf (interp->result, "running");
			break;
		case UchTextService::isLost:
			sprintf (interp->result, "lost");
			break;
		}
	} else if (strcmp (cmd, "close") == 0) {
		Tcl_DeleteCommand (interp, (char*) agent->GetName ());
		agent->Close ();
	} else if (strcmp (cmd, "closenow") == 0) {
		Tcl_DeleteCommand (interp, (char*) agent->GetName ());
		agent->CloseNow ();
	} else {
		Tcl_AppendResult(interp, "bad option name: \"", cmd,
			"\"", (char *) NULL);
		return TCL_ERROR;
	}
	
	return TCL_OK;
}

/*
 *	command to create a new agent:
 *		agent name [-option value ...]
 */
int
CreateAgentCmd (ClientData, Tcl_Interp* interp, int argc, char* argv [])
{
	TclAgent*	agent;
	
	/* check arguments: at least two, and even number overall */
	if (argc < 2 || (argc & 01) != 0) {
		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
			" name [-option value ...]\"", (char *) NULL);
		return TCL_ERROR;
	}
	
	char* name = argv [1];
	char* host = 0;
	agent = new TclAgent (interp, name);
	
	for (int i = 2; i < argc; i++) {
		char* option = argv [i++];
		char* value = argv [i];
		if (strcmp (option, "-host") == 0)
			host = value;
		else
		if (strcmp (option, "-name") == 0)
			name = value;
		else
		if (strcmp (option, "-init") == 0)
			agent->SetGotServerCmd (value);
		else
		if (strcmp (option, "-lost") == 0)
			agent->SetLostServerCmd (value);
		else
		if (strcmp (option, "-abandon") == 0)
			agent->SetAbandonCmd (value);
		else {
			Tcl_AppendResult(interp, "bad option name: \"", argv[i-1],
				"\"", (char *) NULL);
			return TCL_ERROR;
		}
	}

	agent->Init (name, host);
	
	/* define the command for manipulating the source */
	Tcl_CreateCommand (interp, name, AgentCmd, (ClientData) agent, 0);
	
	return TCL_OK;
}

//---------------- initialization

/*
 *	initialize the audio gizmo
 *	returns 0 if error and leaves the message in interp->result
 */
UchTkMultiplexer mpx;

extern "C" int
InitAgent (Tcl_Interp* interp)
{
	Tcl_CreateCommand (interp, "agent", CreateAgentCmd, 0, 0);
	
	return 1;
}

extern "C" int tkmain (int, char* []);

main (int argc, char* argv [])
{
	return tkmain (argc, argv);
}