# Problem is very simple: <b>tclsh</b>. I have no idea how to put all of
# the TCL commands onto the same line as "tclsh" command. ELSE I have no
# idea how to work with the generated <b>tclsh</b> environment from
# Apache/PHP.
How about
exec(".../tclsh <<':eof'\ntcl script\ntcl script\n...\n:e of",&output)
Also probably needs updating:
/*
PHP=/usr/local/src/php-4.0.4pl1
ZEND=/usr/local/src/php-4.0.4pl1/Zend
tclphp.o: $(GENERIC_DIR)/tclphp.c
$(CC) -w -DCOMPILE_DL=1 -I$(PHP) -I$(PHP)/main -I$(PHP)/TSRM -I$(ZEND) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclphp.c
tclphp.so: ${OBJS} tclphp.o ${STUB_LIB_FILE }
rm -f ${TCL_LIB_FILE}
${SHLIB_LD} -o tclphp.so ${OBJS} tclphp.o ${LIBS}
$(RANLIB) tclphp.so
<?php
//dl("tclphp.so") ;
$param = "MiXeD cAsE";
$return = tclphp("string tolower \{$param}");
print("We sent \"$param\" and got \"$return\"" );
?>
*/
/*
tclphp [type] script
Standard Tcl plus one function:
php expression ...
tclphp.so
This function.
tcl8.3.so
*/
#define IS_EXT_MODULE
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "php.h"
#include "tcl.h"
static int isLong(Tcl_Obj *obj,long *lval) {
char *s = Tcl_GetStringFr omObj(obj,0),*t ;
*lval = strtol(s,&t,0);
return s!=t && !*t;
}
static Tcl_Interp *interp = 0;
/* declaration of functions to be exported */
ZEND_FUNCTION(t clphp);
ZEND_MINIT_FUNC TION(tclphp);
ZEND_MSHUTDOWN_ FUNCTION(tclphp );
/* compiled function list so Zend knows what's in this module */
zend_function_e ntry tclphp_function s[] = {
ZEND_FE(tclphp, NULL)
{NULL,NULL,NULL }
};
/* compiled module information */
zend_module_ent ry tclphp_module_e ntry = {
"tclphp module",
tclphp_function s,
ZEND_MINIT(tclp hp),ZEND_MSHUTD OWN(tclphp),NUL L,NULL,NULL,
STANDARD_MODULE _PROPERTIES
};
/* implement standard "stub" routine to introduce ourselves to Zend */
#if COMPILE_DL
ZEND_GET_MODULE (tclphp)
#endif
ZEND_MINIT_FUNC TION(tclphp) {
char initialisation[] =
"source $tcl_pkgPath/tcl$tcl_version/init.tcl\n"
;
interp = Tcl_CreateInter p();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory( interp);
#endif
if (Tcl_Init(inter p)==TCL_ERROR) {
Tcl_DString S;
Tcl_DStringInit (&S);
Tcl_DStringAppe nd(&S,"interpre tter Tcl_Init failed: ",-1);
Tcl_DStringAppe nd(&S,Tcl_GetSt ringResult(inte rp),-1);
zend_error(E_WA RNING,Tcl_DStri ngValue(&S));
Tcl_DStringFree (&S);
return FAILURE;
}
Tcl_SetVar(inte rp,"tcl_rcFileN ame","~/.tclshrc",TCL_G LOBAL_ONLY);
Tcl_SourceRCFil e(interp);
if (Tcl_Eval(inter p,initialisatio n)!=TCL_OK) {
Tcl_DString S;
Tcl_DStringInit (&S);
Tcl_DStringAppe nd(&S,"interpre tter initialisation failed: ",-1);
Tcl_DStringAppe nd(&S,Tcl_GetSt ringResult(inte rp),-1);
Tcl_DStringAppe nd(&S,": ",-1);
Tcl_DStringAppe nd(&S,initialis ation,-1);
zend_error(E_WA RNING,Tcl_DStri ngValue(&S));
Tcl_DStringFree (&S);
return FAILURE;
}
return SUCCESS;
}
ZEND_MSHUTDOWN_ FUNCTION(tclphp ) {
Tcl_DeleteInter p(interp);
interp = 0;
return SUCCESS;
}
/* implement function that is meant to be made available to PHP */
ZEND_FUNCTION(t clphp) {
int argc = ZEND_NUM_ARGS() ;
zval **script;
zval **type;
char Type;
int rc;
Tcl_Obj *Script,*result ;
/*
Argument processing.
*/
if (argc==1) {
if (zend_get_param eters_ex(1,&scr ipt)!=SUCCESS) WRONG_PARAM_COU NT;
Type = 's';
}else if (argc==2) {
if (zend_get_param eters_ex(2,&typ e,&script)!=SUC CESS) WRONG_PARAM_COU NT;
if (argc==2 && (*type)->type!=IS_STRIN G) convert_to_stri ng_ex(type);
Type = tolower(Z_STRVA L_PP(type)[0]);
}else {
WRONG_PARAM_COU NT;
}
if ((*script)->type!=IS_STRIN G) {
convert_to_stri ng_ex(script);
}
/*
Evaluate the script and coerce to the desired return value.
*/
Script = Tcl_NewStringOb j(Z_STRVAL_PP(s cript),Z_STRLEN _PP(script));
Tcl_IncrRefCoun t(Script);
rc = Tcl_EvalObjEx(i nterp,Script,TC L_EVAL_DIRECT|T CL_EVAL_GLOBAL) ;
Tcl_DecrRefCoun t(Script);
result = Tcl_GetObjResul t(interp);
switch (rc==TCL_OK ? Type : 0) {
case 0: /*error*/ error: {
char *s = Tcl_GetStringRe sult(interp);
zend_error(E_WA RNING,s);
RETVAL_NULL();
} break;
case 'd': /*double*/ {
double d;
if (Tcl_GetDoubleF romObj(interp,r esult,&d)!=TCL_ OK) goto error;
RETVAL_DOUBLE(d );
} break;
case 'i': case 'l': /*long int*/ {
long l;
if (Tcl_GetLongFro mObj(interp,res ult,&l)!=TCL_OK ) goto error;
RETVAL_LONG(l);
} break;
case 'b': /*boolean*/ {
int b;
if (Tcl_GetBoolean FromObj(interp, result,&b)!=TCL _OK) goto error;
if (b) {RETVAL_TRUE;}
else {RETVAL_FALSE;}
} break;
case 'a': /*array*/ {
int N; Tcl_Obj **P;
if (Tcl_ListObjGet Elements(interp ,result,&N,&P)! =TCL_OK) goto error;
else if (N&1) {
Tcl_SetResult(i nterp,"returned list for array has odd number of elements",TCL_S TATIC);
goto error;
}
array_init(retu rn_value);
for (; N>0; N-=2,P+=2) {
long lval; int bval; double dval; char *sval; int slen;
if (isLong(P[0],&lval)) {
long index = lval;
if (isLong(P[1],&lval)) {
add_index_long( return_value,in dex,lval);
}else if (Tcl_GetDoubleF romObj(0,P[1],&dval)==TCL_OK ) {
add_index_doubl e(return_value, index,dval);
}else if (Tcl_GetLongFro mObj(0,P[1],&lval)==TCL_OK ) {
add_index_long( return_value,in dex,lval);
}else if (Tcl_GetBoolean FromObj(0,P[1],&bval)==TCL_OK ) {
add_index_long( return_value,in dex,(long)bval) ;
}else {
sval = Tcl_GetStringFr omObj(P[1],&slen);
add_index_strin gl(return_value ,index,sval,sle n,1);
}
}else {
char *key = Tcl_GetStringFr omObj(P[0],0);
if (isLong(P[1],&lval)) {
add_assoc_long( return_value,ke y,lval);
}else if (Tcl_GetDoubleF romObj(0,P[1],&dval)==TCL_OK ) {
add_assoc_doubl e(return_value, key,dval);
}else if (Tcl_GetLongFro mObj(0,P[1],&lval)==TCL_OK ) {
add_assoc_long( return_value,ke y,lval);
}else if (Tcl_GetBoolean FromObj(0,P[1],&bval)==TCL_OK ) {
add_assoc_long( return_value,ke y,(long)bval);
}else {
sval = Tcl_GetStringFr omObj(P[1],&slen);
add_assoc_strin gl(return_value ,key,sval,slen, 1);
}
}
}
} break;
default: /*string*/ {
int n; char *s = Tcl_GetStringFr omObj(result,&n );
RETVAL_STRINGL( s,n,1);
} break;
}
/*
Clean up and quit.
*/
Tcl_ResetResult (interp);
return;
}
--
SM Ryan
http://www.rawbw.com/~wyrmwif/
Where do you get those wonderful toys?
