/* Daniel Reeves  http://ai.eecs.umich.edu/people/dreeves/ */
/* last changed on 2006.03.31 */

/* MASH: MAthematica Scripting Hack */
/* Prototype of how "math -script" should work.
   This works the same way the perl executable does:
     * it takes a mathematica source file as it's first argument
       (or from stdin if no arguments),
     * makes all the arguments available to the mathematica code as an 
       array (list) called ARGV, 
     * evaluates the code,
     * prints to stdout only what it is explicitly told to.
   The advantages of this include having a self-contained mathematica
     program that can be executed (with arguments) from the command line.
   It can be used for interactive shell programs or cgi scripts.
   NOTE: some things not yet implemented, see TODO's in the code.
   TODO: there should be a way to have unbuffered output or to explicitly
         flush.
*/

#include <stdio.h>
#include <stdlib.h>
#include <signal.h>
#include <string.h>   /* strcat */
#include "mathlink.h"

/* TODO: phlip_cpp@my-deja.com says that single quotes are needed
          in COMMANDLINEARGS */
/* constants... */   /* EDIT HERE: your path to mathematica */
#define COMMANDLINEARGS \
"-linkname \'/usr/bin/math -mathlink -noinit -batchinput\' -linkmode launch"
/* EDIT HERE: your path to MathIO.m, included with mash */
#define PATHTOMATHIO "/home/dreeves/eecs/mash/MathIO.m"
#define NONASCIICHAR  88L  /* if kernel returns non-ascii char, use X (88) */
#define MAXLINELENGTH 1000  /* TODO: make this dynamic! */

/* globals... */  
MLENV stdenv = (MLENV)0; 
MLINK stdlink = (MLINK)0;

/* prototypes... */
int process_string_token(FILE * f);
void openlink(void);
void closelink(void);
static void signal_catcher(int);


/****************************  MAIN  *********************************/

int main(int argc, char ** argv) 
{
  FILE * source;
  short int c;
  int done = 0;
  int packet_tag;
  unsigned char * s;
  char line[MAXLINELENGTH];
  long i;

  /*
  fprintf(stderr, "DIAGNOSTICS:  previous disposition of SIGINT was %d\n", 
          (int) signal(SIGINT, signal_catcher));
  fprintf(stderr, "DIAGNOSTICS:  previous disposition of SIGTERM was %d\n",
          (int) signal(SIGTERM, signal_catcher));
  */
  
  fprintf(stderr, "[M]");  /* DIAGNOSTICS: Starting Mathematica... */

  /*
  fprintf(stderr, "<raising SIGINT returned %d>\n", raise(SIGINT));
  */


  if (argc == 1) { source = stdin; }
  else {
    source = fopen(argv[1], "r");
    if (source == NULL) {
      fprintf(stderr, "Cannot open math script \"%s\"\n", argv[1]);
      exit(1);
    }
  }

  openlink(); 
/*
  fprintf(stderr, "DEBUG-CHECK-GOOD1\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/

  /* Some useful stuff I'd like defined for all mash scripts... */
  MLPutFunction(stdlink, "EvaluatePacket", 1L);
/*
  fprintf(stderr, "DEBUG-CHECK-GOOD2\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/
    MLPutFunction(stdlink, "Get", 1L);
      MLPutString(stdlink, PATHTOMATHIO);
  MLEndPacket(stdlink);
/*
  fprintf(stderr, "DEBUG-CHECK-GOOD3\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/
  if(MLError(stdlink)) {
    fprintf(stderr, "MathLink Error(0): %s.\n", MLErrorMessage(stdlink));  
    exit(1);
  }  
/*
  fprintf(stderr, "DEBUG-CHECK-GOOD4\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/
  while ((packet_tag = MLNextPacket(stdlink)) && packet_tag != RETURNPKT) { 
/*
    switch (packet_tag) {
      case RETURNPKT:
      case RETURNTEXTPKT:
        fprintf(stderr, "DEBUG: packet_tag: RETURN*PKT\n"); 
        break;
      case INPUTNAMEPKT:
      case OUTPUTNAMEPKT:
        fprintf(stderr, "DEBUG: packet_tag: INPUT/OUTPUTNAMEPKT\n");
        break;
      case TEXTPKT:
        fprintf(stderr, "DEBUG: packet_tag: TEXTPKT\n");
        process_string_token(stdout);
        break;
      case MESSAGEPKT:
        fprintf(stderr, "DEBUG: packet_tag: MESSAGEPKT\n");
        break;
      case DISPLAYPKT: 
        fprintf(stderr, "DEBUG: packet_tag: DISPLAYPKT\n");
        break;
      case DISPLAYENDPKT:
        fprintf(stderr, "DEBUG: packet_tag: DISPLAYENDPKT\n");
        break;
      case INPUTPKT:
        fprintf(stderr, "DEBUG: packet_tag: INPUTPKT (tag=%d)\n", packet_tag);
        break;
      case INPUTSTRPKT:
        fprintf(stderr, "DEBUG: packet_tag: INPUTSTRPKT (tag=%d)\n",packet_tag);
        break;
      case CALLPKT:
        fprintf(stderr, "DEBUG: packet_tag: CALLPKT (tag=%d)\n", packet_tag);
        break;
      case SUSPENDPKT:
        fprintf(stderr, "DEBUG: packet_tag: SUSPENDPKT (tag=%d)\n", packet_tag);
        break;
      default:
        fprintf(stderr,
                "MathLink Error: Unknown or unexpected packet tag (tag=%d)\n",
                packet_tag);
        break;
    }
*/

    MLNewPacket(stdlink); 
  }
/*
  fprintf(stderr, "DEBUG-CHECK-GOOD5\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/
  MLNewPacket(stdlink);
  if(MLError(stdlink)) {
    fprintf(stderr, "MathLink Error(1): %s.\n", MLErrorMessage(stdlink));  
    fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
    fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
    fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
    exit(1);
  }  

/*
  fprintf(stderr, "DEBUGCHECK-BAD1\n");
  fprintf(stderr, "MLActivate(stdlink) == %d, ", MLActivate(stdlink));
  fprintf(stderr, "MLFlush(stdlink) == %d, ", MLFlush(stdlink));
  fprintf(stderr, "MLReady(stdlink) == %d\n", MLReady(stdlink));
*/

  /* Get the command line args and put them in a list called ARGV,
     available to the mathematica script... */

  MLPutFunction(stdlink, "EvaluatePacket", 1L);
    MLPutFunction(stdlink, "Set", 2L);
      MLPutSymbol(stdlink, "ARGV");
      MLPutFunction(stdlink, "List", 1L);

        for (i = 1; i < argc; i++) {
          MLPutFunction(stdlink, "Sequence", 2L);
          MLPutString(stdlink, argv[i]);
        }
        MLPutFunction(stdlink, "Sequence", 0L);
  MLEndPacket(stdlink);
  while (MLNextPacket(stdlink) != RETURNPKT) { 
    MLNewPacket(stdlink); 
  }
  MLNewPacket(stdlink);
  if(MLError(stdlink)) {
    fprintf(stderr, "MathLink Error(2): %s.\n", MLErrorMessage(stdlink));  
  }  

  /* TODO: ignore the first line if it looks like #!/path/mash */

  /* Slurp the whole source file and have Mathematica evaluate it... */
  /* TODO: I don't know how inefficient this is but even if it's ok
	it may not always be correct.  Like Begin[context] and the
	corresponding End[] have to be evaluated separately... */

  MLPutFunction(stdlink, "EvaluatePacket", 1L);
    MLPutFunction(stdlink, "ToExpression", 1L);
      MLPutFunction(stdlink, "FromCharacterCode", 1L);
        MLPutFunction(stdlink, "List", 1L);

          /* TODO: how many lines of code before this method breaks? */
          /*       haven't tried more than maybe 1000 lines */
          while ((c = getc(source)) != EOF) {
            MLPutFunction(stdlink, "Sequence", 2L);
            MLPutShortInteger(stdlink, (short int) c);
          }
          fclose(source);
          /* fprintf(stderr, "(input has been read)\n"); */
          /* TODO: start timing */

          MLPutFunction(stdlink, "Sequence", 0L);
  MLEndPacket(stdlink);


  while(!done) { 
    /* fprintf(stderr, "Top of while loop.\n"); */
    MLNewPacket(stdlink); 
    packet_tag = MLNextPacket(stdlink);
    switch (packet_tag) {
      case RETURNPKT:  
      case RETURNTEXTPKT:  
        /* fprintf(stderr, "packet_tag: RETURN*PKT\n"); */
        /* sent one big packet to kernel so we're done when it returns */
        done = 1;
        break;
      case INPUTNAMEPKT:  
      case OUTPUTNAMEPKT:  
        fprintf(stderr, "packet_tag: INPUT/OUTPUTNAMEPKT\n");
        /* we should never get these since we only send EvaluatePackets */
        break;
      case TEXTPKT: 
        process_string_token(stdout);
        break;
      case MESSAGEPKT: 
        /* TODO: need to MLGetSymbol for the symbol, then MLGetString
           for the tag.
           A TEXTPKT will follow after that with the message. */
        fprintf(stderr, "packet_tag: MESSAGEPKT\n");
        printf("\n");  /* TODO: temporary kludge */
        break;
      case DISPLAYPKT:   /* TODO: what to do with these? */
        printf("packet_tag: DISPLAYPKT\n");
        break;
      case DISPLAYENDPKT:  
        printf("packet_tag: DISPLAYENDPKT\n");
        break;
      case INPUTPKT: 
        /* TODO: how to handle input... (see case below for InputString *) */
        /* Need to send back a TextPacket (as op to an EvaluatePacket) */
        fprintf(stderr, 
                "Unexpected packet tag INPUTPKT (tag=%d)\n", packet_tag);
        printf("<begin input>");
        s = 0;  /* TODO: this will be the string we read in... */
        while ((c = getc(stdin)) != EOF) { printf("%c", c); }
        printf("<end input>\n");
        /* process_string_token(stdout); */
        break;
      case INPUTSTRPKT:
        /* TODO: just hacking this together... */
        /* fprintf(stderr, "<ABOUT TO GET STDIN AND SEND IT TO KERNEL>\n"); */
        line[0] = 0;  /* was NULL */
        if(gets(line)) { strcat(line, "\n"); }
        MLPutFunction(stdlink, "TextPacket", 1L);
          MLPutString(stdlink, line);
        MLEndPacket(stdlink);
        if(MLError(stdlink)) {
          fprintf(stderr, "MathLink Error with INPUTSTRPKT: %s.\n", 
                  MLErrorMessage(stdlink));  
        }  
        /* fprintf(stderr, "<END INPUT>\n"); */
        break;
      case CALLPKT:
        fprintf(stderr, 
                "MathLink Error: Unexpected packet tag CALLPKT (tag=%d)\n", 
                packet_tag);
        closelink();
        exit(1);
      case SUSPENDPKT:
        fprintf(stderr, 
                "DIAGNOSTICS:  Exit[] called.\n");
        /* TODO: this is what happens when we call Exit[].
           we need to get the return value and return it from this program

           TODO: also, what about when this (mash) process is killed?
           the mathkernel should die too...
           may have to trap SIGABORT or something to achieve that.
           probably can't do it for kill -9 but ctrl-C yes.
           hmmm....
        */
        done = 1;
        break;
      default: 
        /* TODO: for some reason this is happening with tag=21 when 
           I call InputString in a mash script... 
        */
        fprintf(stderr, 
                "MathLink Error: Unknown or unexpected packet tag (tag=%d)\n", 
                packet_tag);
        /* closelink(); */
        /* exit(1); */
        done = 1;
        break;
    }
  }
/*
  fprintf(stderr, "DEBUG-CHECK-BAD2\n");
*/

  if(MLError(stdlink)) {
    fprintf(stderr, "MathLink Error(3): %s.\n", MLErrorMessage(stdlink));  
    exit(1);
  }  
    
  /* TODO: stop timing */
  fprintf(stderr, "[~M]\n"); /* DIAGNOSTICS:  Exiting Mathematica. */
  closelink();
  return 0;
}


/***********************  OTHER FUNCTIONS  ****************************/

int process_string_token(FILE * f)
{
  int token_tag;
  const unsigned char * s;
  long n;
  long i;

        token_tag = MLGetNext(stdlink);
        if (token_tag != MLTKSTR) {
          fprintf(stderr,
                  "MathLink Error:  Expected MLTKSTR (tag %d), not tag %d\n",
                  MLTKSTR, token_tag);
          exit(1);
        }
        if(MLGetByteString(stdlink, &s, &n, NONASCIICHAR)) { 
          for (i = 0; i < n; i++) { fprintf(f, "%c", s[i]); }
          MLDisownByteString(stdlink, s, n); 
        }

  return 0;
}


void deinit(void) { if(stdenv) { MLDeinitialize(stdenv); } }
void mlclose(void) { if(stdlink) { MLClose(stdlink); } }

void openlink(void)
{
	long err;

	stdenv = MLInitialize((MLParametersPointer)0);
	if(stdenv == (MLENV)0) { exit(1); }
	atexit(deinit);

   stdlink = MLOpenString(stdenv, COMMANDLINEARGS, &err);
   /* stdlink = MLOpenArgv(stdenv, argv, argv + argc, &err); */
 	if(stdlink == (MLINK)0) { exit(2); }
	atexit(mlclose); 
}


void closelink(void)
{
  /*
  MLClose(stdlink);
  MLDeinitialize(stdenv);
  */
  MLPutFunction(stdlink, "Exit", 0);
}

static void signal_catcher(int signo)
{
/* TODO (from PJ Hinton):
I don't know how to force the kernel to adhere strictly to the child
process behavior.  Believe me, this problem also causes trouble in other
areas.  Say you have a front end connected to a kernel that is running a
large calculation within a tight loop, and you decide to kill the kernel
using the front end Quit Kernel menu command.  There are instances where
the kernel will ignore the fact that the link has been closed on the front
end side and will continue to run on its merry way.

Your best bet is to bite the bullet with signal handler code.  This is
what the developers here in house had to do with the Integrator perl
scripts.  One thing you may be able to take advantage of is the fact that
the kernel's process ID is accessible through a global session variable.
You could include as part of the kernel's init.m a command like:
 
        WriteString["some_file", $ProcessID]

Where the filename is passed as part of a -run or -runfirst command line
argument to the kernel and contains the process ID of the parent process.
As part of your signal handler code, you could read from this file (you
know its name from the process id of the script) and do a kill on the
process ID therein.  In essence, you're doing something akin to the .pid
files in /var/run.
*/

  fprintf(stderr, "<caught signal %d>\n", signo);
  /*
  while (MLNextPacket(stdlink) != RETURNPKT) { 
    fprintf(stderr, "MLNextPacket != RETURNPKT, calling MLNewPacket\n");
    MLNewPacket(stdlink); 
  }
  */

  /*
  MLNewPacket(stdlink);
  MLPutFunction(stdlink, "EvaluatePacket", 1L);
  */

  MLPutFunction(stdlink, "Abort", 0L);

  /*
  MLEndPacket(stdlink);
  */

  /*
  while (MLNextPacket(stdlink) != RETURNPKT) { 
    fprintf(stderr, "MLNextPacket != RETURNPKT, calling MLNewPacket\n");
    MLNewPacket(stdlink); 
  }
  */

  /* closelink(); */
  exit(1);
}