Removed the "signal" and "last signal" signals. Changed perl's

signaling system to work without them, it should now work faster and
better.


git-svn-id: http://svn.irssi.org/repos/irssi/trunk@1053 dbcabf3a-b0e7-0310-adc4-f8d773084564

11 files changed, 451 insertions, 418 deletions

diff --git a/src/core/signals.c b/src/core/signals.c
index 3c1e4281..d1416a79 100644
--- a/src/core/signals.c
+++ b/src/core/signals.c
@@ -25,6 +25,8 @@
 #define SIGNAL_LISTS 3
 
 typedef struct {
+	int id; /* signal id */
+
 	int emitting; /* signal is being emitted */
 	int altered; /* some signal functions are marked as NULL */
 	int stop_emit; /* this signal was stopped */
@@ -39,8 +41,6 @@ typedef struct {
 
 static GMemChunk *signals_chunk;
 static GHashTable *signals;
-static int first_signal_id, last_signal_id;
-static SIGNAL_REC *first_signal_rec, *last_signal_rec; /* "signal" and "last signal" */
 static SIGNAL_REC *current_emitted_signal;
 
 void signal_add_to(const char *module, int pos,
@@ -64,14 +64,10 @@ void signal_add_to_id(const char *module, int pos,
 	rec = g_hash_table_lookup(signals, GINT_TO_POINTER(signal_id));
 	if (rec == NULL) {
 		rec = g_mem_chunk_alloc0(signals_chunk);
+                rec->id = signal_id;
 		g_hash_table_insert(signals, GINT_TO_POINTER(signal_id), rec);
 	}
 
-	if (signal_id == first_signal_id)
-		first_signal_rec = rec;
-	else if (signal_id == last_signal_id)
-		last_signal_rec = rec;
-
 	if (rec->siglist[pos] == NULL) {
 		rec->siglist[pos] = g_ptr_array_new();
 		rec->modulelist[pos] = g_ptr_array_new();
@@ -92,11 +88,6 @@ static void signal_destroy(int signal_id)
 		g_hash_table_remove(signals, GINT_TO_POINTER(signal_id));
 		g_free(rec);
 	}
-
-	if (first_signal_rec == rec)
-                first_signal_rec = NULL;
-	else if (last_signal_rec == rec)
-                last_signal_rec = NULL;
 }
 
 static int signal_list_find(GPtrArray *array, void *data)
@@ -207,7 +198,10 @@ static int signal_emit_real(SIGNAL_REC *rec, gconstpointer *arglist)
 			if (func != NULL) {
                                 prev_emitted_signal = current_emitted_signal;
 				current_emitted_signal = rec;
-				func(arglist[0], arglist[1], arglist[2], arglist[3], arglist[4], arglist[5], arglist[6]);
+#if SIGNAL_MAX_ARGUMENTS != 6
+#  error SIGNAL_MAX_ARGS changed - update code
+#endif
+				func(arglist[0], arglist[1], arglist[2], arglist[3], arglist[4], arglist[5]);
 				current_emitted_signal = prev_emitted_signal;
 			}
 
@@ -237,33 +231,20 @@ static int signal_emit_real(SIGNAL_REC *rec, gconstpointer *arglist)
 
 static int signal_emitv_id(int signal_id, int params, va_list va)
 {
-	gconstpointer arglist[8];
+	gconstpointer arglist[SIGNAL_MAX_ARGUMENTS];
 	SIGNAL_REC *rec;
 	int n;
 
 	g_return_val_if_fail(signal_id >= 0, FALSE);
-	g_return_val_if_fail(params >= 0 && params <= sizeof(arglist)/sizeof(arglist[0]), FALSE);
+	g_return_val_if_fail(params >= 0 && params <= SIGNAL_MAX_ARGUMENTS, FALSE);
 
-	arglist[0] = GINT_TO_POINTER(signal_id);
-	for (n = 1; n < 8; n++)
+	for (n = 0; n < SIGNAL_MAX_ARGUMENTS; n++)
 		arglist[n] = n > params ? NULL : va_arg(va, gconstpointer);
 
-	/* send "signal" */
-	if (first_signal_rec != NULL) {
-		if (signal_emit_real(first_signal_rec, arglist))
-			return TRUE;
-	}
-
 	rec = g_hash_table_lookup(signals, GINT_TO_POINTER(signal_id));
-	if (rec != NULL && signal_emit_real(rec, arglist+1))
+	if (rec != NULL && signal_emit_real(rec, arglist))
 		return TRUE;
 
-	/* send "last signal" */
-	if (last_signal_rec != NULL) {
-		if (signal_emit_real(last_signal_rec, arglist))
-			return TRUE;
-	}
-
 	return rec != NULL;
 }
 
@@ -323,7 +304,24 @@ void signal_stop_by_name(const char *signal)
 		rec->stop_emit++;
 }
 
-static void signal_remove_module(void *signal, SIGNAL_REC *rec, const char *module)
+/* return the name of the signal that is currently being emitted */
+const char *signal_get_emitted(void)
+{
+	return signal_get_id_str(signal_get_emitted_id());
+}
+
+/* return the ID of the signal that is currently being emitted */
+int signal_get_emitted_id(void)
+{
+	SIGNAL_REC *rec;
+
+	rec = current_emitted_signal;
+        g_return_val_if_fail(rec != NULL, -1);
+	return rec->id;
+}
+
+static void signal_remove_module(void *signal, SIGNAL_REC *rec,
+				 const char *module)
 {
 	unsigned int index;
 	int signal_id, list;
@@ -354,11 +352,6 @@ void signals_init(void)
 	signals_chunk = g_mem_chunk_new("signals", sizeof(SIGNAL_REC),
 					sizeof(SIGNAL_REC)*200, G_ALLOC_AND_FREE);
 	signals = g_hash_table_new((GHashFunc) g_direct_hash, (GCompareFunc) g_direct_equal);
-
-	first_signal_rec = NULL;
-	last_signal_rec = NULL;
-        first_signal_id = signal_get_uniq_id("signal");
-        last_signal_id = signal_get_uniq_id("last signal");
 }
 
 static void signal_free(void *key, SIGNAL_REC *rec)
diff --git a/src/core/signals.h b/src/core/signals.h
index f1fabf6c..d3fc41bd 100644
--- a/src/core/signals.h
+++ b/src/core/signals.h
@@ -1,16 +1,20 @@
 #ifndef __SIGNAL_H
 #define __SIGNAL_H
 
+#define SIGNAL_MAX_ARGUMENTS 6
 typedef void (*SIGNAL_FUNC) (gconstpointer, gconstpointer,
 			     gconstpointer, gconstpointer,
-			     gconstpointer, gconstpointer, gconstpointer);
+			     gconstpointer, gconstpointer);
 
 void signals_init(void);
 void signals_deinit(void);
 
-/* use this macro to convert the signal name to ID */
+/* signal name -> ID */
 #define signal_get_uniq_id(signal) \
         module_get_uniq_id_str("signals", signal)
+/* signal ID -> name */
+#define signal_get_id_str(signal_id) \
+	module_find_id_str("signals", signal_id)
 
 /* bind a signal */
 void signal_add_to(const char *module, int pos,
@@ -34,6 +38,11 @@ void signal_stop(void);
 /* stop ongoing signal emission by signal name */
 void signal_stop_by_name(const char *signal);
 
+/* return the name of the signal that is currently being emitted */
+const char *signal_get_emitted(void);
+/* return the ID of the signal that is currently being emitted */
+int signal_get_emitted_id(void);
+
 /* remove all signals that belong to `module' */
 void signals_remove_module(const char *module);
 
diff --git a/src/perl/.cvsignore b/src/perl/.cvsignore
index 04cb6224..ecb47a34 100644
--- a/src/perl/.cvsignore
+++ b/src/perl/.cvsignore
@@ -6,4 +6,4 @@
 Makefile
 Makefile.in
 so_locations
-perl-signals.h
+perl-signals-list.h
diff --git a/src/perl/Makefile.am b/src/perl/Makefile.am
index 08117856..f1168d06 100644
--- a/src/perl/Makefile.am
+++ b/src/perl/Makefile.am
@@ -8,7 +8,7 @@ EXTRA_LTLIBRARIES = libperl.la libperl_static.la
 
 libperl_la_LDFLAGS = -avoid-version -rpath $(moduledir)
 
-perl.c: perl-signals.h
+perl.c: perl-signals-list.h
 
 INCLUDES = $(GLIB_CFLAGS) \
 	-DSCRIPTDIR=\""$(libdir)/irssi/scripts"\" \
@@ -19,6 +19,7 @@ INCLUDES = $(GLIB_CFLAGS) \
 perl_sources = \
 	perl.c \
 	perl-common.c \
+	perl-signals.c \
 	xsinit.c
 
 libperl_la_DEPENDENCIES = .libs/libperl_orig.a .libs/DynaLoader.a
@@ -38,8 +39,8 @@ libperl_la_SOURCES = \
 libperl_static_la_SOURCES = \
 	$(perl_sources)
 
-perl-signals.h: $(top_srcdir)/docs/signals.txt $(srcdir)/get-signals.pl
-	cat $(top_srcdir)/docs/signals.txt | $(perlpath) $(srcdir)/get-signals.pl > perl-signals.h
+perl-signals-list.h: $(top_srcdir)/docs/signals.txt $(srcdir)/get-signals.pl
+	cat $(top_srcdir)/docs/signals.txt | $(perlpath) $(srcdir)/get-signals.pl > perl-signals-list.h
 
 CORE_SOURCES = \
 	common/Channel.xs \
@@ -84,7 +85,8 @@ EXTRA_DIST = \
 
 noinst_HEADERS = \
 	module.h \
-	perl-common.h
+	perl-common.h \
+	perl-signals.h
 
 all-local:
 	for dir in common irc; do cd $$dir && if [ ! -f Makefile ]; then if [ "x$(PERL_LIB_DIR)" = "x" ]; then $(perlpath) Makefile.PL; else $(perlpath) Makefile.PL LIB=$(PERL_LIB_DIR); fi; fi && if ! $(MAKE); then $(MAKE); fi && cd ..; done
diff --git a/src/perl/common/Core.xs b/src/perl/common/Core.xs
index 1f8993e9..7229cd4f 100644
--- a/src/perl/common/Core.xs
+++ b/src/perl/common/Core.xs
@@ -28,6 +28,13 @@ CODE:
 	perl_signal_add(signal, func);
 
 void
+signal_add_first(signal, func)
+	char *signal
+	char *func
+CODE:
+	perl_signal_add_first(signal, func);
+
+void
 signal_add_last(signal, func)
 	char *signal
 	char *func
diff --git a/src/perl/common/module.h b/src/perl/common/module.h
index 7a035c6c..5942bc2c 100644
--- a/src/perl/common/module.h
+++ b/src/perl/common/module.h
@@ -32,6 +32,7 @@
 #include "fe-common/core/keyboard.h"
 
 #include "perl/perl-common.h"
+#include "perl/perl-signals.h"
 
 typedef COMMAND_REC *Irssi__Command;
 typedef LOG_REC *Irssi__Log;
diff --git a/src/perl/module.h b/src/perl/module.h
index 986e32e1..4e1d9b2f 100644
--- a/src/perl/module.h
+++ b/src/perl/module.h
@@ -1,3 +1,17 @@
+#include <EXTERN.h>
+#ifndef _SEM_SEMUN_UNDEFINED
+#define HAS_UNION_SEMUN
+#endif
+#include <perl.h>
+
+#undef _
+#undef PACKAGE
+
+/* For compatibility with perl 5.004 and older */
+#ifndef ERRSV
+#  define ERRSV GvSV(errgv)
+#endif
+
 #include "common.h"
 
 #define MODULE_NAME "irssi-perl"
diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c
index f683a4a0..99be6c89 100644
--- a/src/perl/perl-common.c
+++ b/src/perl/perl-common.c
@@ -18,15 +18,6 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
-#include <EXTERN.h>
-#ifndef _SEM_SEMUN_UNDEFINED
-#define HAS_UNION_SEMUN
-#endif
-#include <perl.h>
-
-#undef _
-#undef PACKAGE
-
 #include "module.h"
 #include "modules.h"
 #include "signals.h"
diff --git a/src/perl/perl-signals.c b/src/perl/perl-signals.c
new file mode 100644
index 00000000..3734873f
--- /dev/null
+++ b/src/perl/perl-signals.c
@@ -0,0 +1,350 @@
+#include "module.h"
+#include "modules.h"
+#include "signals.h"
+#include "commands.h"
+#include "servers.h"
+
+#include "perl-common.h"
+
+typedef struct {
+	int signal_id;
+	char *signal;
+
+	char *func;
+	int priority;
+} PERL_SIGNAL_REC;
+
+typedef struct {
+	int signal_id;
+	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 int perl_call_signal(const char *func, int signal_id,
+			    gconstpointer *args)
+{
+	dSP;
+	int retcount, ret;
+
+	PERL_SIGNAL_ARGS_REC *rec;
+	HV *stash;
+	SV *perlarg;
+        void *arg;
+	int n;
+
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(sp);
+
+	/* push signal argument to perl stack */
+	rec = perl_signal_args_find(signal_id);
+
+	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 (strncmp(rec->args[n], "gslist_", 7) == 0) {
+			/* linked list - push as AV */
+			GSList *tmp;
+			AV *av;
+
+			av = newAV();
+			stash = gv_stashpv(rec->args[n]+7, 0);
+			for (tmp = arg; tmp != NULL; tmp = tmp->next)
+				av_push(av, sv_2mortal(new_bless(tmp->data, stash)));
+			perlarg = (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 its first
+			   variables (server, channel, ..) */
+			perlarg = irssi_bless((SERVER_REC *) arg);
+		} else {
+			/* blessed object */
+			perlarg = irssi_bless_plain(rec->args[n], arg);
+		}
+                XPUSHs(sv_2mortal(perlarg));
+	}
+
+	PUTBACK;
+	retcount = perl_call_pv((char *) func, G_EVAL|G_SCALAR);
+	SPAGAIN;
+
+	ret = 0;
+	if (SvTRUE(ERRSV)) {
+		STRLEN n_a;
+
+		signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
+		(void)POPs;
+	} else if (retcount > 0) {
+		SV *sv = POPs;
+
+		if (SvIOK(sv) && SvIV(sv) == 1) ret = 1;
+		while (--retcount > 0)
+			(void)POPi;
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	return ret;
+}
+
+static void sig_func(int priority, gconstpointer *args)
+{
+	GSList **list, *tmp;
+        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 = tmp->next) {
+		PERL_SIGNAL_REC *rec = tmp->data;
+
+		if (perl_call_signal(rec->func, signal_id, args)) {
+			signal_stop();
+			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 perl_signal_get_func(rec) \
+	((rec)->priority == 0 ? sig_func_first : \
+	(rec)->priority == 1 ? sig_func_default : sig_func_last)
+
+void perl_signal_add_to(const char *signal, const char *func, int priority)
+{
+	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);
+
+		signal_add_to_id(MODULE_NAME, priority, rec->signal_id,
+                                 perl_signal_get_func(rec));
+	}
+
+	*siglist = g_slist_append(*siglist, rec);
+}
+
+static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
+{
+	if (strncmp(rec->signal, "command ", 8) == 0)
+		command_unbind(rec->signal+8, NULL);
+
+	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, func);
+	}
+	g_free(fullfunc);
+}
+
+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_signals_package_destroy(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]);
+	}
+}
+
+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 {
+			g_hash_table_insert(perl_signal_args_hash,
+					    GINT_TO_POINTER(rec->signal_id),
+					    rec);
+		}
+	}
+}
+
+void perl_signals_deinit(void)
+{
+        g_slist_free(perl_signal_args_partial);
+        g_hash_table_destroy(perl_signal_args_hash);
+}
diff --git a/src/perl/perl-signals.h b/src/perl/perl-signals.h
new file mode 100644
index 00000000..ddebfeec
--- /dev/null
+++ b/src/perl/perl-signals.h
@@ -0,0 +1,23 @@
+#ifndef __PERL_SIGNALS_H
+#define __PERL_SIGNALS_H
+
+void perl_signal_add_to(const char *signal, const char *func, int priority);
+#define perl_signal_add_first(signal, func) \
+        perl_signal_add_to(signal, func, 0)
+#define perl_signal_add(signal, func) \
+        perl_signal_add_to(signal, func, 1)
+#define perl_signal_add_last(signal, func) \
+        perl_signal_add_to(signal, func, 2)
+
+void perl_signal_remove(const char *signal, const char *func);
+
+/* destroy all signals used by package */
+void perl_signals_package_destroy(const char *package);
+
+void perl_signals_start(void);
+void perl_signals_stop(void);
+
+void perl_signals_init(void);
+void perl_signals_deinit(void);
+
+#endif
diff --git a/src/perl/perl.c b/src/perl/perl.c
index 943636fc..f233e295 100644
--- a/src/perl/perl.c
+++ b/src/perl/perl.c
@@ -18,31 +18,18 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
-#include <EXTERN.h>
-#ifndef _SEM_SEMUN_UNDEFINED
-#define HAS_UNION_SEMUN
-#endif
-#include <perl.h>
-
-#undef _
-#undef PACKAGE
-
 #include "module.h"
-#include "modules.h"
 #include "signals.h"
 #include "commands.h"
 #include "misc.h"
-#include "perl-common.h"
-#include "servers.h"
 
 #include "fe-common/core/themes.h"
 #include "fe-common/core/formats.h"
 
-/* For compatibility with perl 5.004 and older */
-#ifndef ERRSV
-#  define ERRSV GvSV(errgv)
-#endif
+#include "perl-common.h"
+#include "perl-signals.h"
 
+/* For compatibility with perl 5.004 and older */
 #ifndef HAVE_PL_PERL
 #  define PL_perl_destruct_level perl_destruct_level
 #endif
@@ -50,73 +37,14 @@
 extern void xs_init(void);
 
 typedef struct {
-	int signal_id;
-	char *signal;
-	char *args[7];
-} PERL_SIGNAL_ARGS_REC;
-
-typedef struct {
-	char *signal;
-	int signal_id;
-
-	char *func;
-	int last;
-} PERL_SIGNAL_REC;
-
-typedef struct {
 	int tag;
 	char *func;
 	char *data;
 } PERL_SOURCE_REC;
 
-#include "perl-signals.h"
-
-static GHashTable *first_signals, *last_signals;
 static GSList *perl_sources;
 static GSList *perl_scripts;
 static PerlInterpreter *irssi_perl_interp;
-static int signal_grabbed, siglast_grabbed;
-
-static void sig_signal(void *signal, ...);
-static void sig_lastsignal(void *signal, ...);
-
-static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
-{
-	GHashTable *table;
-	GSList **siglist;
-	void *signal_idp;
-
-	g_return_if_fail(rec != NULL);
-
-	table = rec->last ? last_signals : first_signals;
-	signal_idp = GINT_TO_POINTER(rec->signal_id);
-
-	siglist = g_hash_table_lookup(table, signal_idp);
-	if (siglist == NULL) return;
-
-	*siglist = g_slist_remove(*siglist, rec);
-	if (*siglist == NULL) {
-		g_free(siglist);
-		g_hash_table_remove(table, signal_idp);
-	}
-
-	if (!rec->last && signal_grabbed && g_hash_table_size(first_signals) == 0) {
-		signal_grabbed = FALSE;
-		signal_remove("signal", (SIGNAL_FUNC) sig_signal);
-	}
-
-	if (rec->last && siglast_grabbed && g_hash_table_size(last_signals) == 0) {
-		siglast_grabbed = FALSE;
-		signal_remove("last signal", (SIGNAL_FUNC) sig_lastsignal);
-	}
-
-	if (strncmp(rec->signal, "command ", 8) == 0)
-		command_unbind(rec->signal+8, NULL);
-
-	g_free(rec->signal);
-	g_free(rec->func);
-	g_free(rec);
-}
 
 static void perl_source_destroy(PERL_SOURCE_REC *rec)
 {
@@ -159,10 +87,7 @@ static void irssi_perl_start(void)
 		"  die $@ if $@;\n"
 		"}\n";
 
-	first_signals = g_hash_table_new((GHashFunc) g_direct_hash,
-					 (GCompareFunc) g_direct_equal);
-	last_signals = g_hash_table_new((GHashFunc) g_direct_hash,
-					(GCompareFunc) g_direct_equal);
+        perl_signals_start();
 	perl_sources = NULL;
 
 	irssi_perl_interp = perl_alloc();
@@ -174,36 +99,6 @@ static void irssi_perl_start(void)
         perl_common_init();
 }
 
-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;
-
-		if (strncmp(rec->signal, "command ", 8) == 0)
-			command_unbind(rec->signal+8, NULL);
-
-		*list = g_slist_remove(*list, rec);
-
-		g_free(rec->signal);
-		g_free(rec->func);
-		g_free(rec);
-	}
-
-	if (*list != NULL)
-		return FALSE;
-
-	g_free(list);
-	return TRUE;
-}
-
 static void perl_unregister_theme(const char *package)
 {
 	FORMAT_REC *formats;
@@ -232,11 +127,7 @@ static int perl_script_destroy(const char *name)
 	package = g_strdup_printf("Irssi::Script::%s", name);
 	package_len = strlen(package);
 
-	/* signals */
-	g_hash_table_foreach_remove(first_signals,
-				    (GHRFunc) signal_destroy_hash, package);
-	g_hash_table_foreach_remove(last_signals,
-				    (GHRFunc) signal_destroy_hash, package);
+        perl_signals_package_destroy(package);
 
 	/* timeouts and input waits */
 	for (tmp = perl_sources; tmp != NULL; tmp = next) {
@@ -261,24 +152,7 @@ static void irssi_perl_stop(void)
 	GSList *tmp;
 	char *package;
 
-	/* signals */
-	g_hash_table_foreach(first_signals,
-			     (GHFunc) signal_destroy_hash, NULL);
-	g_hash_table_destroy(first_signals);
-	g_hash_table_foreach(last_signals,
-			     (GHFunc) signal_destroy_hash, NULL);
-	g_hash_table_destroy(last_signals);
-	first_signals = last_signals = NULL;
-
-	if (signal_grabbed) {
-		signal_grabbed = FALSE;
-		signal_remove("signal", (SIGNAL_FUNC) sig_signal);
-	}
-
-	if (siglast_grabbed) {
-		siglast_grabbed = FALSE;
-		signal_remove("last signal", (SIGNAL_FUNC) sig_lastsignal);
-	}
+        perl_signals_stop();
 
 	/* timeouts and input waits */
 	while (perl_sources != NULL)
@@ -431,84 +305,6 @@ static void cmd_perlflush(const char *data)
 	irssi_perl_start();
 }
 
-static void perl_signal_to(const char *signal, const char *func, int last)
-{
-	PERL_SIGNAL_REC *rec;
-	GHashTable *table;
-	GSList **siglist;
-	void *signal_idp;
-
-	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->last = last;
-
-	table = last ? last_signals : first_signals;
-	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);
-	}
-
-	*siglist = g_slist_append(*siglist, rec);
-
-	if (!last && !signal_grabbed) {
-		signal_grabbed = TRUE;
-		signal_add("signal", (SIGNAL_FUNC) sig_signal);
-	} else if (last && !siglast_grabbed) {
-		siglast_grabbed = TRUE;
-		signal_add("last signal", (SIGNAL_FUNC) sig_lastsignal);
-	}
-}
-
-void perl_signal_add(const char *signal, const char *func)
-{
-	perl_signal_to(signal, func, FALSE);
-}
-
-void perl_signal_add_last(const char *signal, const char *func)
-{
-	perl_signal_to(signal, func, TRUE);
-}
-
-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_destroy(rec);
-			break;
-		}
-	}
-}
-
-void perl_signal_remove(const char *signal, const char *func)
-{
-	GSList **list;
-	char *fullfunc;
-	int signal_id;
-
-	signal_id = signal_get_uniq_id(signal);
-
-	fullfunc = g_strdup_printf("%s::%s", perl_get_package(), func);
-	list = g_hash_table_lookup(first_signals, GINT_TO_POINTER(signal_id));
-	if (list != NULL)
-		perl_signal_remove_list(list, func);
-	else {
-		list = g_hash_table_lookup(last_signals, GINT_TO_POINTER(signal_id));
-		if (list != NULL) perl_signal_remove_list(list, func);
-	}
-	g_free(fullfunc);
-}
-
 static int perl_source_event(PERL_SOURCE_REC *rec)
 {
 	dSP;
@@ -583,158 +379,6 @@ void perl_source_remove(int tag)
 	}
 }
 
-static PERL_SIGNAL_ARGS_REC *perl_signal_find(int signal)
-{
-	const char *signame;
-	int n;
-
-	for (n = 0; perl_signal_args[n].signal != NULL; n++) {
-		if (signal == perl_signal_args[n].signal_id)
-			return &perl_signal_args[n];
-	}
-
-	/* try to find by name */
-	signame = module_find_id_str("signals", signal);
-	for (n = 0; perl_signal_args[n].signal != NULL; n++) {
-		if (strncmp(signame, perl_signal_args[n].signal,
-			    strlen(perl_signal_args[n].signal)) == 0)
-			return &perl_signal_args[n];
-	}
-
-	return NULL;
-}
-
-/* get arguments to args */
-static int perl_get_args(int signal, SV **args, va_list va)
-{
-	PERL_SIGNAL_ARGS_REC *rec;
-	HV *stash;
-	void *arg;
-	int n;
-
-	rec = perl_signal_find(signal);
-	if (rec == NULL)
-		return 0;
-
-	for (n = 0; n < 7 && rec->args[n] != NULL; n++) {
-		arg = va_arg(va, void *);
-
-		if (strcmp(rec->args[n], "string") == 0)
-			args[n] = new_pv(arg);
-		else if (strcmp(rec->args[n], "int") == 0)
-			args[n] = newSViv(GPOINTER_TO_INT(arg));
-		else if (strcmp(rec->args[n], "ulongptr") == 0)
-			args[n] = newSViv(*(unsigned long *) arg);
-		else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
-			/* linked list - push as AV */
-			GSList *tmp;
-			AV *av;
-
-			av = newAV();
-			stash = gv_stashpv(rec->args[n]+7, 0);
-			for (tmp = arg; tmp != NULL; tmp = tmp->next)
-				av_push(av, sv_2mortal(new_bless(tmp->data, stash)));
-			args[n] = (SV*)av;
-		} else if (arg == NULL) {
-			/* don't bless NULL arguments */
-			args[n] = newSViv(0);
-		} else if (strcmp(rec->args[n], "iobject") == 0) {
-			/* "irssi object" - any struct that has
-			   "int type; int chat_type" as its first
-			   variables (server, channel, ..) */
-			args[n] = irssi_bless((SERVER_REC *) arg);
-		} else {
-			/* blessed object */
-			args[n] = irssi_bless_plain(rec->args[n], arg);
-		}
-	}
-        return n;
-}
-
-static int call_perl(const char *func, int signal, va_list va)
-{
-	dSP;
-        SV *args[7];
-	int retcount, ret;
-
-        int n, count;
-
-	/* save the arguments to SV*[] list first, because irssi_bless()
-	   calls perl_call_method() and trashes the stack */
-	count = perl_get_args(signal, args, va);
-
-	ENTER;
-	SAVETMPS;
-
-	PUSHMARK(sp);
-	for (n = 0; n < count; n++)
-                XPUSHs(sv_2mortal(args[n]));
-
-	PUTBACK;
-	retcount = perl_call_pv((char *) func, G_EVAL|G_SCALAR);
-	SPAGAIN;
-
-	ret = 0;
-	if (SvTRUE(ERRSV)) {
-		STRLEN n_a;
-
-		signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
-		(void)POPs;
-	} else if (retcount > 0) {
-		SV *sv = POPs;
-
-		if (SvIOK(sv) && SvIV(sv) == 1) ret = 1;
-		while (--retcount > 0)
-			(void)POPi;
-	}
-
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
-
-	return ret;
-}
-
-static void sig_signal(void *signal, ...)
-{
-	GSList **list, *tmp;
-	va_list va;
-
-	va_start(va, signal);
-
-	list = g_hash_table_lookup(first_signals, signal);
-	for (tmp = list == NULL ? NULL : *list; tmp != NULL; tmp = tmp->next) {
-		PERL_SIGNAL_REC *rec = tmp->data;
-
-		if (call_perl(rec->func, GPOINTER_TO_INT(signal), va)) {
-			signal_stop();
-			break;
-		}
-	}
-
-	va_end(va);
-}
-
-static void sig_lastsignal(void *signal, ...)
-{
-	GSList **list, *tmp;
-	va_list va;
-
-	va_start(va, signal);
-
-	list = g_hash_table_lookup(last_signals, signal);
-	for (tmp = list == NULL ? NULL : *list; tmp != NULL; tmp = tmp->next) {
-		PERL_SIGNAL_REC *rec = tmp->data;
-
-		if (call_perl(rec->func, GPOINTER_TO_INT(signal), va)) {
-			signal_stop();
-			break;
-		}
-	}
-
-	va_end(va);
-}
-
 static void irssi_perl_autorun(void)
 {
 	DIR *dirp;
@@ -766,19 +410,18 @@ void perl_init(void)
 	command_bind_first("unload", NULL, (SIGNAL_FUNC) cmd_unload);
 	command_bind("perl", NULL, (SIGNAL_FUNC) cmd_perl);
 	command_bind("perlflush", NULL, (SIGNAL_FUNC) cmd_perlflush);
-	signal_grabbed = siglast_grabbed = FALSE;
 
-        PL_perl_destruct_level = 1;
+	PL_perl_destruct_level = 1;
+	perl_signals_init();
 	irssi_perl_start();
 	irssi_perl_autorun();
 }
 
 void perl_deinit(void)
 {
+	perl_signals_deinit();
 	irssi_perl_stop();
 
-	if (signal_grabbed) signal_remove("signal", (SIGNAL_FUNC) sig_signal);
-	if (siglast_grabbed) signal_remove("last signal", (SIGNAL_FUNC) sig_lastsignal);
 	command_unbind("run", (SIGNAL_FUNC) cmd_run);
 	command_unbind("unload", (SIGNAL_FUNC) cmd_unload);
 	command_unbind("perl", (SIGNAL_FUNC) cmd_perl);