/* ARISA - Perl Engine - UI Linkage
 * Copyright (C) 2004 Carl Ritson
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 */

#define NEED_PERL_H

#include <EXTERN.h>
#include <perl.h>

#include <XSUB.h>

#include "arisa.h"
#include "script-eng.h"
#include "admin.h"
#include "admin-interface.h"
#include "engine.h"
#include "linkage.h"
#include "ui.h"

// Structure Definitions
typedef struct perl_ui_call_t {
	pthread_mutex_t	lock;
	pthread_cond_t 	cond;
	void		*id;
	acontext_t	*context;
	char		**args;
	int		no_args;
	volatile int	ret_val;
	volatile int	valid;
} perl_ui_call_t;


// Global Variables
acontext_t *perl_ui_valid_context = NULL;


// Functions
static perl_ui_call_t *alloc_call(void *id, 
		acontext_t *context, char **args, int no_args) {
	perl_ui_call_t *c = xalloc(sizeof(perl_ui_call_t));
	
	LOCK_INIT(&c->lock);
	pthread_cond_init(&c->cond,NULL);
	
	c->id		= id;
	c->context	= context;
	c->args		= args;
	c->no_args	= no_args;
	c->ret_val	= 0;
	c->valid	= 1;

	return c;
}

static void free_call(perl_ui_call_t *c) {
	LOCK_FREE(&c->lock);
	pthread_cond_destroy(&c->cond);
	xfree(c);
}

MENU_CMD_NS(perl_make_ui_call) {
	perl_ui_call_t *c = alloc_call(menu_cmd,ac,args,no_args);
	struct timespec timeout;
	struct timeval now;
	int ret, ran = 0;

	LOCK(c);
	se_ui_call(perl_engine_interpreter,c);
	
	gettimeofday(&now,NULL);
	timeout.tv_sec = now.tv_sec + 10;
	timeout.tv_nsec = now.tv_usec * 1000;
	
	if(pthread_cond_timedwait(&c->cond,&c->lock,&timeout) == 0) {
		ret = c->ret_val;
		ran = 1;
	} else {
		pqueue_push_back(ac->msgqueue,xstrdup("Call Failed"));
		ret = RET_EXE_ERR;
	}
	
	c->valid = 0;
	
	UNLOCK(c);

	if(ran)
		free_call(c);

	return ret;
	
}

static void make_perl_call(plocal_t *l, perl_ui_call_t *c) {
	dSP;
	
	ENTER;
	SAVETMPS;
	
	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSViv((IV)c->id)));
	XPUSHs(sv_2mortal(create_ptr_object("Arisa::UI::Context",c->context)));
	XPUSHs(sv_2mortal(newRV_noinc((SV*)strarr_to_av(c->args,c->no_args))));
	PUTBACK;

	perl_call_pv("Arisa::UI::_call", G_EVAL | G_SCALAR);

	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		char *error = SvPV(ERRSV, PL_na);
		if (error != NULL)
			LOGTP(L_ERR,"Perl Error: %s",error);
		c->ret_val = RET_EXE_ERR;
	} else {
		c->ret_val = POPi;
	}

	PUTBACK;

	FREETMPS;
	LEAVE;
}

void perl_handle_ui_call(plocal_t *l, se_msg_t *msg) {
	perl_ui_call_t *c = (perl_ui_call_t *)msg->ui.data;

	LOCK(c);
	if(c->valid == 0) {
		UNLOCK(c);
		free_call(c);
		return;
	}
	pthread_cond_signal(&c->cond);
	perl_ui_valid_context = c->context;
	make_perl_call(l,c);
	perl_ui_valid_context = NULL;
	UNLOCK(c);
}