Hello,
After consulting the php-sources I could hack the tclsqlite.c file
myself to add aggregation capabilities to tcl, this should go into the
next release:
the diff:
2c2
< ** 2001 September 15
---
> ** 2004 June 8 added aggregate function by Dr. Detlef Groth (dgroth at gmx.de)
43a44,54
> /*
> ** New SQL aggregate functions can be created as TCL scripts. Each such aggregate
> function
> ** is described by an instance of the following structure.
> */
> typedef struct SqlAggrFunc SqlAggrFunc;
> struct SqlAggrFunc {
> Tcl_Interp *interp; /* The TCL interpret to execute the function */
> char *zScriptStep; /* The script to be run foreach row*/
> char *zScriptFine; /* The script to be run at the end*/
> SqlFunc *pNext; /* Next function on the list of them all */
> };
399a411,447
> static void tclSqlAggStep(sqlite_func *context, int argc, const char **argv){
> SqlAggrFunc *p = sqlite_user_data(context);
> Tcl_DString cmd;
> int i;
> int rc;
> int zargc , zargs;
> zargc = argc ;
> Tcl_DStringInit(&cmd);
> Tcl_DStringAppend(&cmd, p->zScriptStep, -1);
> for(i=0; i<(zargc); i++){
> Tcl_DStringAppendElement(&cmd, argv[0] ? argv[i] : "");
> }
> rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));
> if( rc ){
> sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1);
> }else{
> sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1);
> }
> }
>
> /** This routine is called to evaluate an SQL aggregate implemented
> ** using TCL script.
> */
> static void tclSqlAggFine(sqlite_func *context){
> SqlAggrFunc *p = sqlite_user_data(context);
> int rc;
> Tcl_DString cmd;
> Tcl_DStringInit(&cmd);
> Tcl_DStringAppend(&cmd, p->zScriptFine, -1);
> rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));
> if( rc ){
> sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1);
> }else{
> sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1);
> }
> }
>
493c541
< "errorcode", "eval", "function",
---
> "errorcode", "eval", "function", "aggregate",
502c550
< DB_ERRORCODE, DB_EVAL, DB_FUNCTION,
---
> DB_ERRORCODE, DB_EVAL, DB_FUNCTION, DB_AGGREGATE,
864a913,944
> }
> /*
> ** $db aggregate NAME SCRIPTSTEP SCRIPTFINALIZE
> **
> ** Create a new SQL aggregate function called NAME. Whenever that function is
> ** called, invoke SCRIPTINIT for each row and SCRIPTFINALIZE at the end to
> evaluate the function.
> */
> case DB_AGGREGATE: {
> SqlAggrFunc *pFunc;
> char *zName;
> char *zScript;
> char *zScriptFine;
> int nScript1;
> int nScript2;
> if( objc!=5 ){
> Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPTSTEP SCRIPTFINALIZE");
> return TCL_ERROR;
> }
> zName = Tcl_GetStringFromObj(objv[2], 0);
> zScript = Tcl_GetStringFromObj(objv[3], &nScript1);
> zScriptFine = Tcl_GetStringFromObj(objv[4], &nScript2);
> pFunc = (SqlAggrFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript1 +nScript2 + 1 );
> if( pFunc==0 ) return TCL_ERROR;
> pFunc->interp = interp;
> pFunc->zScriptStep = (char*)&pFunc[1];
> pFunc->pNext = pDb->pFunc;
> pFunc->zScriptFine = (char*)&pFunc[2];
> strcpy(pFunc->zScriptStep, zScript);
> strcpy(pFunc->zScriptFine, zScriptFine);
> sqlite_create_aggregate(pDb->db, zName, -1, tclSqlAggStep, tclSqlAggFine,
> pFunc);
> sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC);
> break;
Here comes an usage example in tcl:
load tclsqlite-stub-aggr.dll
sqlite sql d:/data/yaspo2004bt.sqlite
# the old function interface
sql function median Median
# the new aggregate interface
sql aggregate medianAgg MedianAggStep MedianAggFin
set l [list]
proc Median {value} {
global l
lappend l $value
# crude and slow but works
return [lindex [lsort -integer $l] [expr round([llength $l] / 2)]]
}
set v [lindex [sql eval "select median(Size) from tensembl"] end]
tk_messageBox -type ok -title "Info!" -message "Result: $v"
set l [list]
set v ""
proc MedianAggStep {args} {
global l
lappend l [lindex $args 0]
return 0
}
proc MedianAggFin {} {
global l
# this is just executed ones
return [lindex [lsort -integer $l] [expr round([llength $l] / 2)]]
}
array unset val
sql eval "select medianAgg(Size) from tensembl" val {
# to get the key
set key [array names val medianA*]
tk_messageBox -type ok -title "Info!" -message "Result Aggregate: $val($key)"
}
regards,
Detlef
--
Dr. Detlef Groth
Max-Planck-Institut
fuer Molekulare Genetik
Ihnestr. 63/73
D-14195 Berlin
Tel.: + 49 30 - 8413 1235
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
