#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <stdlib.h>             /* for malloc */

#include "tcl.h"

int   _tcl_argc;
char *_tcl_argv[] = {
  "tclsh",
};

Tcl_Interp *interp = NULL;

#define DECREF(x) { Tcl_DecrRefCount(x); }

#define PERROR printf

#ifndef SvPV_nolen
static STRLEN n_a;
#define SvPV_nolen(x) SvPV(x,n_a)
#endif

/****************************
 * SV* Tcl2Pl(Tcl_Obj *obj) 
 * 
 * Converts Tcl Objects to Perl data structures
 * 
 ****************************/
SV* Tcl2Pl (char *result, char *perl_class) {
   /* Here is how it does it:
    * o If obj is a String, Integer, or Float, we convert it to an SV;
    * o If obj is a List or Tuple, we convert it to an AV;
    * o If obj is a Dictionary, we convert it to an HV.
    */
    SV *s2;
    s2 = newSVpv(result,0);
    return s2;
}

/****************************
 * Tcl_Obj* Pl2Py(SV *obj)
 * 
 * Converts a Perl data structures to a Tcl Object
 ****************************/
char *Pl2Tcl (SV *obj) {
   char *str;
   str = (char *)SvPV(obj, PL_na);
   return str;	
}

MODULE = Inline::Tcl   PACKAGE = Inline::Tcl

BOOT:
interp = Tcl_CreateInterp();
Tcl_Init(interp);

PROTOTYPES: DISABLE

void 
_Inline_parse_tcl_namespace()
 PREINIT:
    Tcl_Obj *listPtr, *elemObjPtr;
    Tcl_Obj **objvPtr;
    char *result;
    int objc,i;
    AV* functions = newAV();
 PPCODE:
    /*
     * Get the pattern and find the "effective namespace" in which to
     * list commands.
     */

    if (TCL_ERROR == Tcl_Eval(interp, "info commands") ) {
	PERROR("Namespace: Eval Error\n");
    }

    listPtr = Tcl_GetObjResult(interp);
    /* error check ? */

    if (TCL_ERROR == Tcl_ListObjGetElements(interp, listPtr, &objc, &objvPtr)){
	PERROR("Namespace: List error\n");
    }

    if (TCL_ERROR == Tcl_ListObjLength(interp, listPtr, &objc) ) {
	PERROR("Namespace: List Length error\n");
    }

    for (i=0;i<objc;i++) {
	if (TCL_ERROR == Tcl_ListObjIndex(interp, listPtr, i, &elemObjPtr)){
	    PERROR("Namespace: List Length error\n");
        }
	result = Tcl_GetString(elemObjPtr); /* error check ? */
        av_push(functions, newSVpv(result,0));
    }

    PUSHs(newSVpv("functions",0));
    PUSHs(newRV_noinc((SV*)functions));

int 
_eval_tcl(x)
	char *x; 
    PREINIT:
	int result;
    CODE:
	result = Tcl_Eval(interp,x);
	RETVAL = (result == TCL_OK);
    OUTPUT:
	RETVAL

void
_eval_tcl_function(PKG, FNAME...)
     char*    PKG;
     char*    FNAME;
  PREINIT:
  int i;
  char *result;
  SV* ret = NULL;
  char *command;
  int cmdlen;
  int len;
  PPCODE:

  cmdlen = 0;

  for (i=1; i<items; i++) {
    result = Pl2Tcl(ST(i));
    if (result) {
      len = strlen(result);
      cmdlen += len;
    }
  }

  command = (char *)malloc( sizeof(char) * (cmdlen+2) );
  command[0] = 0x0;
  if (command == NULL ) {	
	PERROR("Out of memory\n");
	XSRETURN_EMPTY;
  }
  for (i=1; i<items; i++) {
      strcat(command, Pl2Tcl(ST(i)));
      strcat(command, " ");
  }

  Tcl_Eval(interp, command);
  result = Tcl_GetStringResult(interp);
  ret = Tcl2Pl(result, PKG);

  free(command);

  if (SvROK(ret) && (SvTYPE(SvRV(ret)) == SVt_PVAV)) {
    AV* av = (AV*)SvRV(ret);
    int len = av_len(av) + 1;
    int i;
    for (i=0; i<len; i++) {
      XPUSHs(sv_2mortal(av_shift(av)));
    }
  } else {
    XPUSHs(ret);
  }