irssi/src/perl/perl-signals.c

/*
 perl-signals.c : irssi

    Copyright (C) 1999-2001 Timo Sirainen

    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 "module.h"
#include "modules.h"
#include "signals.h"
#include "commands.h"
#include "servers.h"

#include "perl-core.h"
#include "perl-common.h"
#include "perl-signals.h"

typedef struct {
	int signal_id;
	char *signal;

	char *func;
	int priority;
} PERL_SIGNAL_REC;

typedef struct {
	char *signal;
	char *args[7];
} PERL_SIGNAL_ARGS_REC;

#include "perl-signals-list.h"

static GHashTable *signals[3];
static GHashTable *perl_signal_args_hash;
static GSList *perl_signal_args_partial;

static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
{
	PERL_SIGNAL_ARGS_REC *rec;
        GSList *tmp;
	const char *signame;

	rec = g_hash_table_lookup(perl_signal_args_hash,
				  GINT_TO_POINTER(signal_id));
        if (rec != NULL) return rec;

	/* try to find by name */
	signame = signal_get_id_str(signal_id);
	for (tmp = perl_signal_args_partial; tmp != NULL; tmp = tmp->next) {
		rec = tmp->data;

		if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0)
			return rec;
	}

	return NULL;
}

static void perl_call_signal(const char *func, int signal_id,
			     gconstpointer *args)
{
	dSP;

	PERL_SIGNAL_ARGS_REC *rec;
	SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
	AV *av;
        void *arg;
	int n;


	ENTER;
	SAVETMPS;

	PUSHMARK(sp);

	/* push signal argument to perl stack */
	rec = perl_signal_args_find(signal_id);

        memset(saved_args, 0, sizeof(saved_args));
	for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
		    rec != NULL && rec->args[n] != NULL; n++) {
		arg = (void *) args[n];

		if (strcmp(rec->args[n], "string") == 0)
			perlarg = new_pv(arg);
		else if (strcmp(rec->args[n], "int") == 0)
			perlarg = newSViv(GPOINTER_TO_INT(arg));
		else if (strcmp(rec->args[n], "ulongptr") == 0)
			perlarg = newSViv(*(unsigned long *) arg);
		else if (strcmp(rec->args[n], "intptr") == 0)
			saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg));
		else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
			/* pointer to linked list - push as AV */
			GList *tmp, **ptr;
                        int is_iobject, is_str;

                        is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
                        is_str = strcmp(rec->args[n]+9, "char*") == 0;
			av = newAV();

			ptr = arg;
			for (tmp = *ptr; tmp != NULL; tmp = tmp->next) {
				sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
					is_str ? new_pv(tmp->data) :
					irssi_bless_plain(rec->args[n]+9, tmp->data);
				av_push(av, sv);
			}

			saved_args[n] = perlarg = newRV_noinc((SV *) av);
		} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
			/* linked list - push as AV */
			GSList *tmp;
			int is_iobject;

                        is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
			av = newAV();
			for (tmp = arg; tmp != NULL; tmp = tmp->next) {
				sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
					irssi_bless_plain(rec->args[n]+7, tmp->data);
				av_push(av, sv);
			}

			perlarg = newRV_noinc((SV *) av);
		} else if (arg == NULL) {
			/* don't bless NULL arguments */
			perlarg = newSViv(0);
		} else if (strcmp(rec->args[n], "iobject") == 0) {
			/* "irssi object" - any struct that has
			   "int type; int chat_type" as it's first
			   variables (server, channel, ..) */
			perlarg = iobject_bless((SERVER_REC *) arg);
		} else if (strcmp(rec->args[n], "siobject") == 0) {
			/* "simple irssi object" - any struct that has
			   int type; as it's first variable (dcc) */
			perlarg = simple_iobject_bless((SERVER_REC *) arg);
		} else {
			/* blessed object */
			perlarg = plain_bless(arg, rec->args[n]);
		}
		XPUSHs(sv_2mortal(perlarg));
	}

	PUTBACK;
	perl_call_pv((char *) func, G_EVAL|G_DISCARD);
	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		STRLEN n_a;
                char *package;

                package = perl_function_get_package(func);
		signal_emit("script error", 2,
			    perl_script_find_package(package),
			    SvPV(ERRSV, n_a));
		g_free(package);
                rec = NULL;
	}

        /* restore arguments the perl script modified */
	for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
		    rec != NULL && rec->args[n] != NULL; n++) {
		arg = (void *) args[n];

		if (saved_args[n] == NULL)
                        continue;

		if (strcmp(rec->args[n], "intptr") == 0) {
			int *val = arg;
			*val = SvIV(SvRV(saved_args[n]));
		} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
                        GList **ret = arg;
			GList *out = NULL;
                        void *val;
			STRLEN len;
                        int count;

			av = (AV *) SvRV(saved_args[n]);
                        count = av_len(av);
			while (count-- >= 0) {
				sv = av_shift(av);
				if (SvPOKp(sv))
					val = g_strdup(SvPV(sv, len));
				else
                                        val = GINT_TO_POINTER(SvIV(sv));

				out = g_list_append(out, val);
			}

			if (strcmp(rec->args[n]+9, "char*") == 0)
                                g_list_foreach(*ret, (GFunc) g_free, NULL);
			g_list_free(*ret);
                        *ret = out;
		}
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}

static void sig_func(int priority, gconstpointer *args)
{
	GSList **list, *tmp, *next;
        int signal_id;

        signal_id = signal_get_emitted_id();
	list = g_hash_table_lookup(signals[priority],
				   GINT_TO_POINTER(signal_id));
	for (tmp = list == NULL ? NULL : *list; tmp != NULL; tmp = next) {
		PERL_SIGNAL_REC *rec = tmp->data;

                next = tmp->next;
		perl_call_signal(rec->func, signal_id, args);
		if (signal_is_stopped(signal_id))
                        break;
	}
}

#define SIG_FUNC_DECL(priority, priority_name) \
static void sig_func_##priority_name(gconstpointer p1, gconstpointer p2, \
				     gconstpointer p3, gconstpointer p4, \
				     gconstpointer p5, gconstpointer p6) \
{ \
	gconstpointer args[6]; \
        args[0] = p1; args[1] = p2; args[2] = p3; \
        args[3] = p4; args[4] = p5; args[5] = p6; \
        sig_func(priority, args); \
}

SIG_FUNC_DECL(0, first);
SIG_FUNC_DECL(1, default);
SIG_FUNC_DECL(2, last);

#define priority_get_func(priority) \
	(priority == 0 ? sig_func_first : \
	priority == 1 ? sig_func_default : sig_func_last)

#define perl_signal_get_func(rec) \
	(priority_get_func((rec)->priority))

void perl_signal_add_to_int(const char *signal, const char *func,
			    int priority, int add_signal)
{
	PERL_SIGNAL_REC *rec;
	GHashTable *table;
	GSList **siglist;
	void *signal_idp;

        g_return_if_fail(signal != NULL);
        g_return_if_fail(func != NULL);
        g_return_if_fail(priority >= 0 && priority <= 2);

	rec = g_new(PERL_SIGNAL_REC, 1);
	rec->signal_id = signal_get_uniq_id(signal);
	rec->signal = g_strdup(signal);
	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
	rec->priority = priority;

	table = signals[priority];
	signal_idp = GINT_TO_POINTER(rec->signal_id);

	siglist = g_hash_table_lookup(table, signal_idp);
	if (siglist == NULL) {
		siglist = g_new0(GSList *, 1);
		g_hash_table_insert(table, signal_idp, siglist);

		if (add_signal) {
			signal_add_to_id(MODULE_NAME, priority, rec->signal_id,
					 perl_signal_get_func(rec));
		}
	}

	*siglist = g_slist_append(*siglist, rec);
}

void perl_signal_add_to(const char *signal, const char *func, int priority)
{
        perl_signal_add_to_int(signal, func, priority, TRUE);
}

static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
{
	if (strncmp(rec->signal, "command ", 8) == 0)
		command_unbind(rec->signal+8, sig_func_default);

	g_free(rec->signal);
	g_free(rec->func);
	g_free(rec);
}

static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
{
	void *signal_idp;

	g_return_if_fail(rec != NULL);

	signal_idp = GINT_TO_POINTER(rec->signal_id);

	*siglist = g_slist_remove(*siglist, rec);
	if (*siglist == NULL) {
		signal_remove_id(rec->signal_id, perl_signal_get_func(rec));
		g_free(siglist);
		g_hash_table_remove(signals[rec->priority], signal_idp);
	}

        perl_signal_destroy(rec);
}

static void perl_signal_remove_list(GSList **list, const char *func)
{
	GSList *tmp;

	g_return_if_fail(list != NULL);

	for (tmp = *list; tmp != NULL; tmp = tmp->next) {
		PERL_SIGNAL_REC *rec = tmp->data;

		if (strcmp(func, rec->func) == 0) {
			perl_signal_remove_list_one(list, rec);
			break;
		}
	}
}

void perl_signal_remove(const char *signal, const char *func)
{
	GSList **list;
        void *signal_idp;
	char *fullfunc;
	int n;

	signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));

	fullfunc = g_strdup_printf("%s::%s", perl_get_package(), func);
	for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
		list = g_hash_table_lookup(signals[n], signal_idp);
		if (list != NULL)
			perl_signal_remove_list(list, fullfunc);
	}
	g_free(fullfunc);
}

void perl_command_bind_to(const char *cmd, const char *category,
			  const char *func, int priority)
{
	char *signal;

	command_bind(cmd, category, priority_get_func(priority));

	signal = g_strconcat("command ", cmd, NULL);
	perl_signal_add_to_int(signal, func, priority, FALSE);
	g_free(signal);
}

void perl_command_runsub(const char *cmd, const char *data, 
			 SERVER_REC *server, WI_ITEM_REC *item)
{
	command_runsub(cmd, data, server, item);
}

void perl_command_unbind(const char *cmd, const char *func)
{
	char *signal;

        /* perl_signal_remove() calls command_unbind() */
	signal = g_strconcat("command ", cmd, NULL);
	perl_signal_remove(signal, func);
	g_free(signal);
}

static int signal_destroy_hash(void *key, GSList **list, const char *package)
{
	GSList *tmp, *next;
	int len;

	len = package == NULL ? 0 : strlen(package);
	for (tmp = *list; tmp != NULL; tmp = next) {
		PERL_SIGNAL_REC *rec = tmp->data;

		next = tmp->next;
		if (package != NULL && strncmp(rec->func, package, len) != 0)
                        continue;

		*list = g_slist_remove(*list, rec);
		if (*list == NULL) {
			signal_remove_id(rec->signal_id,
					 perl_signal_get_func(rec));
		}
		perl_signal_destroy(rec);
	}

	if (*list != NULL)
		return FALSE;

	g_free(list);
	return TRUE;
}

/* destroy all signals used by package */
void perl_signal_remove_package(const char *package)
{
	int n;

	for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
		g_hash_table_foreach_remove(signals[n],
					    (GHRFunc) signal_destroy_hash,
					    (void *) package);
	}
}

void perl_signals_start(void)
{
	int n;

	for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
		signals[n] = g_hash_table_new((GHashFunc) g_direct_hash,
					      (GCompareFunc) g_direct_equal);
	}
}

void perl_signals_stop(void)
{
	int n;

	for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
		g_hash_table_foreach(signals[n],
				     (GHFunc) signal_destroy_hash, NULL);
		g_hash_table_destroy(signals[n]);
                signals[n] = NULL;
	}
}

void perl_signals_init(void)
{
	int n;

	perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash,
						 (GCompareFunc) g_direct_equal);
        perl_signal_args_partial = NULL;

	for (n = 0; perl_signal_args[n].signal != NULL; n++) {
		PERL_SIGNAL_ARGS_REC *rec = &perl_signal_args[n];

		if (rec->signal[strlen(rec->signal)-1] == ' ') {
			perl_signal_args_partial =
				g_slist_append(perl_signal_args_partial, rec);
		} else {
                        int signal_id = signal_get_uniq_id(rec->signal);
			g_hash_table_insert(perl_signal_args_hash,
					    GINT_TO_POINTER(signal_id),
					    rec);
		}
	}
}

void perl_signals_deinit(void)
{
        g_slist_free(perl_signal_args_partial);
        g_hash_table_destroy(perl_signal_args_hash);
}