|
|
Posted by SM Ryan on 03/09/06 01:11
# 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:eof",&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_GetStringFromObj(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(tclphp);
ZEND_MINIT_FUNCTION(tclphp);
ZEND_MSHUTDOWN_FUNCTION(tclphp);
/* compiled function list so Zend knows what's in this module */
zend_function_entry tclphp_functions[] = {
ZEND_FE(tclphp,NULL)
{NULL,NULL,NULL}
};
/* compiled module information */
zend_module_entry tclphp_module_entry = {
"tclphp module",
tclphp_functions,
ZEND_MINIT(tclphp),ZEND_MSHUTDOWN(tclphp),NULL,NULL,NULL,
STANDARD_MODULE_PROPERTIES
};
/* implement standard "stub" routine to introduce ourselves to Zend */
#if COMPILE_DL
ZEND_GET_MODULE(tclphp)
#endif
ZEND_MINIT_FUNCTION(tclphp) {
char initialisation[] =
"source $tcl_pkgPath/tcl$tcl_version/init.tcl\n"
;
interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
#endif
if (Tcl_Init(interp)==TCL_ERROR) {
Tcl_DString S;
Tcl_DStringInit(&S);
Tcl_DStringAppend(&S,"interpretter Tcl_Init failed: ",-1);
Tcl_DStringAppend(&S,Tcl_GetStringResult(interp),-1);
zend_error(E_WARNING,Tcl_DStringValue(&S));
Tcl_DStringFree(&S);
return FAILURE;
}
Tcl_SetVar(interp,"tcl_rcFileName","~/.tclshrc",TCL_GLOBAL_ONLY);
Tcl_SourceRCFile(interp);
if (Tcl_Eval(interp,initialisation)!=TCL_OK) {
Tcl_DString S;
Tcl_DStringInit(&S);
Tcl_DStringAppend(&S,"interpretter initialisation failed: ",-1);
Tcl_DStringAppend(&S,Tcl_GetStringResult(interp),-1);
Tcl_DStringAppend(&S,": ",-1);
Tcl_DStringAppend(&S,initialisation,-1);
zend_error(E_WARNING,Tcl_DStringValue(&S));
Tcl_DStringFree(&S);
return FAILURE;
}
return SUCCESS;
}
ZEND_MSHUTDOWN_FUNCTION(tclphp) {
Tcl_DeleteInterp(interp);
interp = 0;
return SUCCESS;
}
/* implement function that is meant to be made available to PHP */
ZEND_FUNCTION(tclphp) {
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_parameters_ex(1,&script)!=SUCCESS) WRONG_PARAM_COUNT;
Type = 's';
}else if (argc==2) {
if (zend_get_parameters_ex(2,&type,&script)!=SUCCESS) WRONG_PARAM_COUNT;
if (argc==2 && (*type)->type!=IS_STRING) convert_to_string_ex(type);
Type = tolower(Z_STRVAL_PP(type)[0]);
}else {
WRONG_PARAM_COUNT;
}
if ((*script)->type!=IS_STRING) {
convert_to_string_ex(script);
}
/*
Evaluate the script and coerce to the desired return value.
*/
Script = Tcl_NewStringObj(Z_STRVAL_PP(script),Z_STRLEN_PP(script));
Tcl_IncrRefCount(Script);
rc = Tcl_EvalObjEx(interp,Script,TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(Script);
result = Tcl_GetObjResult(interp);
switch (rc==TCL_OK ? Type : 0) {
case 0: /*error*/ error: {
char *s = Tcl_GetStringResult(interp);
zend_error(E_WARNING,s);
RETVAL_NULL();
} break;
case 'd': /*double*/ {
double d;
if (Tcl_GetDoubleFromObj(interp,result,&d)!=TCL_OK) goto error;
RETVAL_DOUBLE(d);
} break;
case 'i': case 'l': /*long int*/ {
long l;
if (Tcl_GetLongFromObj(interp,result,&l)!=TCL_OK) goto error;
RETVAL_LONG(l);
} break;
case 'b': /*boolean*/ {
int b;
if (Tcl_GetBooleanFromObj(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_ListObjGetElements(interp,result,&N,&P)!=TCL_OK) goto error;
else if (N&1) {
Tcl_SetResult(interp,"returned list for array has odd number of elements",TCL_STATIC);
goto error;
}
array_init(return_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,index,lval);
}else if (Tcl_GetDoubleFromObj(0,P[1],&dval)==TCL_OK) {
add_index_double(return_value,index,dval);
}else if (Tcl_GetLongFromObj(0,P[1],&lval)==TCL_OK) {
add_index_long(return_value,index,lval);
}else if (Tcl_GetBooleanFromObj(0,P[1],&bval)==TCL_OK) {
add_index_long(return_value,index,(long)bval);
}else {
sval = Tcl_GetStringFromObj(P[1],&slen);
add_index_stringl(return_value,index,sval,slen,1);
}
}else {
char *key = Tcl_GetStringFromObj(P[0],0);
if (isLong(P[1],&lval)) {
add_assoc_long(return_value,key,lval);
}else if (Tcl_GetDoubleFromObj(0,P[1],&dval)==TCL_OK) {
add_assoc_double(return_value,key,dval);
}else if (Tcl_GetLongFromObj(0,P[1],&lval)==TCL_OK) {
add_assoc_long(return_value,key,lval);
}else if (Tcl_GetBooleanFromObj(0,P[1],&bval)==TCL_OK) {
add_assoc_long(return_value,key,(long)bval);
}else {
sval = Tcl_GetStringFromObj(P[1],&slen);
add_assoc_stringl(return_value,key,sval,slen,1);
}
}
}
} break;
default: /*string*/ {
int n; char *s = Tcl_GetStringFromObj(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?
Navigation:
[Reply to this message]
|