Irssi::signal_add(), Irssi::timeout_add(), Irssi::input_add() and their

variants now also allow use of code references.


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

src/perl/common/Core.xs

@@ -27,28 +27,28 @@ CODE:
 void
 signal_add(signal, func)
 	char *signal
-	char *func
+	SV *func
 CODE:
 	perl_signal_add(signal, func);
 
 void
 signal_add_first(signal, func)
 	char *signal
-	char *func
+	SV *func
 CODE:
 	perl_signal_add_first(signal, func);
 
 void
 signal_add_last(signal, func)
 	char *signal
-	char *func
+	SV *func
 CODE:
 	perl_signal_add_last(signal, func);
 
 void
 signal_remove(signal, func)
 	char *signal
-	char *func
+	SV *func
 CODE:
 	perl_signal_remove(signal, func);
 
@@ -72,7 +72,7 @@ signal_get_emitted_id()
 int
 timeout_add(msecs, func, data)
 	int msecs
-	char *func
+	SV *func
 	void *data
 CODE:
 	RETVAL = perl_timeout_add(msecs, func, ST(2));
@@ -104,7 +104,7 @@ int
 input_add(source, condition, func, data)
 	int source
 	int condition
-	char *func
+	SV *func
 	void *data
 CODE:
 	RETVAL = perl_input_add(source, condition, func, ST(2));
@@ -333,7 +333,7 @@ void
 command_bind_first(cmd, func, category = "Perl scripts' commands")
 	char *cmd
 	char *category
-	char *func
+	SV *func
 CODE:
 	perl_command_bind_first(cmd, category, func);
 
@@ -341,7 +341,7 @@ void
 command_bind(cmd, func, category = "Perl scripts' commands")
 	char *cmd
 	char *category
-	char *func
+	SV *func
 CODE:
 	perl_command_bind(cmd, category, func);
 
@@ -349,7 +349,7 @@ void
 command_bind_last(cmd, func, category = "Perl scripts' commands")
 	char *cmd
 	char *category
-	char *func
+	SV *func
 CODE:
 	perl_command_bind_last(cmd, category, func);
 
@@ -365,7 +365,7 @@ CODE:
 void
 command_unbind(cmd, func)
 	char *cmd
-	char *func
+	SV *func
 CODE:
 	perl_command_unbind(cmd, func);
 

src/perl/perl-common.c

@@ -74,6 +74,24 @@ char *perl_function_get_package(const char *function)
         return NULL;
 }
 
+SV *perl_func_sv_inc(SV *func, const char *package)
+{
+	STRLEN n_a;
+	char *name;
+
+	if (SvPOK(func)) {
+		/* prefix with package name */
+		name = g_strdup_printf("%s::%s", package,
+				       (char *) SvPV(func, n_a));
+		func = new_pv(name);
+                g_free(name);
+	} else {
+		SvREFCNT_inc(func);
+	}
+
+        return func;
+}
+
 SV *irssi_bless_iobject(int type, int chat_type, void *object)
 {
         PERL_OBJECT_REC *rec;

src/perl/perl-common.h

@@ -22,6 +22,9 @@ typedef struct {
 const char *perl_get_package(void);
 /* Parses the package part from function name */
 char *perl_function_get_package(const char *function);
+/* If SV is a string, prefix it with given package.
+   Increases the reference counter for the return value. */
+SV *perl_func_sv_inc(SV *func, const char *package);
 
 /* For compatibility with perl 5.004 and older */
 #ifndef HAVE_PL_PERL

src/perl/perl-core.c

@@ -74,8 +74,8 @@ static void perl_script_destroy(PERL_SCRIPT_REC *script)
 
 	signal_emit("script destroyed", 1, script);
 
-	perl_signal_remove_package(script->package);
+	perl_signal_remove_script(script);
-	perl_source_remove_package(script->package);
+	perl_source_remove_script(script);
 
 	g_free(script->name);
 	g_free(script->package);

src/perl/perl-signals.c

@@ -30,10 +30,11 @@
 #include "perl-signals.h"
 
 typedef struct {
+        PERL_SCRIPT_REC *script;
 	int signal_id;
 	char *signal;
 
-	char *func;
+	SV *func;
 	int priority;
 } PERL_SIGNAL_REC;
 
@@ -70,8 +71,8 @@ static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
 	return NULL;
 }
 
-static void perl_call_signal(const char *func, int signal_id,
+static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
-			     gconstpointer *args)
+			     int signal_id, gconstpointer *args)
 {
 	dSP;
 
@@ -155,18 +156,13 @@ static void perl_call_signal(const char *func, int signal_id,
 	}
 
 	PUTBACK;
-	perl_call_pv((char *) func, G_EVAL|G_DISCARD);
+	perl_call_sv(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, script, SvPV(ERRSV, n_a));
-		signal_emit("script error", 2,
-			    perl_script_find_package(package),
-			    SvPV(ERRSV, n_a));
-		g_free(package);
                 rec = NULL;
 	}
 
@@ -224,7 +220,7 @@ static void sig_func(int priority, gconstpointer *args)
 		PERL_SIGNAL_REC *rec = tmp->data;
 
                 next = tmp->next;
-		perl_call_signal(rec->func, signal_id, args);
+		perl_call_signal(rec->script, rec->func, signal_id, args);
 		if (signal_is_stopped(signal_id))
                         break;
 	}
@@ -252,9 +248,10 @@ SIG_FUNC_DECL(2, last);
 #define perl_signal_get_func(rec) \
 	(priority_get_func((rec)->priority))
 
-static void perl_signal_add_to_int(const char *signal, const char *func,
+static void perl_signal_add_to_int(const char *signal, SV *func,
 				   int priority, int command)
 {
+        PERL_SCRIPT_REC *script;
 	PERL_SIGNAL_REC *rec;
 	GHashTable *table;
 	GSList **siglist;
@@ -264,6 +261,9 @@ static void perl_signal_add_to_int(const char *signal, const char *func,
         g_return_if_fail(func != NULL);
         g_return_if_fail(priority >= 0 && priority <= 2);
 
+        script = perl_script_find_package(perl_get_package());
+        g_return_if_fail(script != NULL);
+
 	if (!command && strncmp(signal, "command ", 8) == 0) {
 		/* we used Irssi::signal_add() instead of
 		   Irssi::command_bind() - oh well, allow this.. */
@@ -272,9 +272,10 @@ static void perl_signal_add_to_int(const char *signal, const char *func,
 	}
 
 	rec = g_new(PERL_SIGNAL_REC, 1);
+        rec->script = script;
 	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->func = perl_func_sv_inc(func, perl_get_package());
 	rec->priority = priority;
 
 	table = signals[priority];
@@ -294,7 +295,7 @@ static void perl_signal_add_to_int(const char *signal, const char *func,
 	*siglist = g_slist_append(*siglist, rec);
 }
 
-void perl_signal_add_to(const char *signal, const char *func, int priority)
+void perl_signal_add_to(const char *signal, SV *func, int priority)
 {
         perl_signal_add_to_int(signal, func, priority, FALSE);
 }
@@ -304,8 +305,8 @@ static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
 	if (strncmp(rec->signal, "command ", 8) == 0)
 		command_unbind(rec->signal+8, sig_func_default);
 
+        SvREFCNT_dec(rec->func);
 	g_free(rec->signal);
-	g_free(rec->func);
 	g_free(rec);
 }
 
@@ -327,42 +328,46 @@ static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
         perl_signal_destroy(rec);
 }
 
-static void perl_signal_remove_list(GSList **list, const char *func)
+#define sv_func_cmp(f1, f2, len) \
+	(f1 == f2 || (SvPOK(f1) && SvPOK(f2) && \
+		strcmp((char *) SvPV(f1, len), (char *) SvPV(f2, len)) == 0))
+
+static void perl_signal_remove_list(GSList **list, SV *func)
 {
 	GSList *tmp;
+        STRLEN n_a;
 
 	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) {
+		if (sv_func_cmp(rec->func, func, n_a)) {
 			perl_signal_remove_list_one(list, rec);
 			break;
 		}
 	}
 }
 
-void perl_signal_remove(const char *signal, const char *func)
+void perl_signal_remove(const char *signal, SV *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);
+        func = perl_func_sv_inc(func, perl_get_package());
 	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);
+			perl_signal_remove_list(list, func);
 	}
-	g_free(fullfunc);
+        SvREFCNT_dec(func);
 }
 
 void perl_command_bind_to(const char *cmd, const char *category,
-			  const char *func, int priority)
+			  SV *func, int priority)
 {
 	char *signal;
 
@@ -379,7 +384,7 @@ void perl_command_runsub(const char *cmd, const char *data,
 	command_runsub(cmd, data, server, item);
 }
 
-void perl_command_unbind(const char *cmd, const char *func)
+void perl_command_unbind(const char *cmd, SV *func)
 {
 	char *signal;
 
@@ -389,25 +394,22 @@ void perl_command_unbind(const char *cmd, const char *func)
 	g_free(signal);
 }
 
-static int signal_destroy_hash(void *key, GSList **list, const char *package)
+static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
 {
 	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)
+		if (script == NULL || rec->script == script) {
-                        continue;
+			*list = g_slist_remove(*list, rec);
-
+			if (*list == NULL) {
-		*list = g_slist_remove(*list, rec);
+				signal_remove_id(rec->signal_id,
-		if (*list == NULL) {
+						 perl_signal_get_func(rec));
-			signal_remove_id(rec->signal_id,
+			}
-					 perl_signal_get_func(rec));
+			perl_signal_destroy(rec);
 		}
-		perl_signal_destroy(rec);
 	}
 
 	if (*list != NULL)
@@ -417,15 +419,15 @@ static int signal_destroy_hash(void *key, GSList **list, const char *package)
 	return TRUE;
 }
 
-/* destroy all signals used by package */
+/* destroy all signals used by script */
-void perl_signal_remove_package(const char *package)
+void perl_signal_remove_script(PERL_SCRIPT_REC *script)
 {
 	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);
+					    script);
 	}
 }
 

src/perl/perl-signals.h

@@ -1,7 +1,7 @@
 #ifndef __PERL_SIGNALS_H
 #define __PERL_SIGNALS_H
 
-void perl_signal_add_to(const char *signal, const char *func, int priority);
+void perl_signal_add_to(const char *signal, SV *func, int priority);
 #define perl_signal_add_first(signal, func) \
         perl_signal_add_to(signal, func, 0)
 #define perl_signal_add(signal, func) \
@@ -9,12 +9,12 @@ void perl_signal_add_to(const char *signal, const char *func, int priority);
 #define perl_signal_add_last(signal, func) \
         perl_signal_add_to(signal, func, 2)
 
-void perl_signal_remove(const char *signal, const char *func);
+void perl_signal_remove(const char *signal, SV *func);
-/* remove all signals used by package */
+/* remove all signals used by script */
-void perl_signal_remove_package(const char *package);
+void perl_signal_remove_script(PERL_SCRIPT_REC *script);
 
 void perl_command_bind_to(const char *cmd, const char *category,
-			  const char *func, int priority);
+			  SV *func, int priority);
 #define perl_command_bind_first(cmd, category, func) \
         perl_command_bind_to(cmd, category, func, 0)
 #define perl_command_bind(cmd, category, func) \
@@ -22,7 +22,7 @@ void perl_command_bind_to(const char *cmd, const char *category,
 #define perl_command_bind_last(cmd, category, func) \
         perl_command_bind_to(cmd, category, func, 2)
 
-void perl_command_unbind(const char *cmd, const char *func);
+void perl_command_unbind(const char *cmd, SV *func);
 
 void perl_signals_start(void);
 void perl_signals_stop(void);

src/perl/perl-sources.c

@@ -26,9 +26,11 @@
 #include "perl-common.h"
 
 typedef struct {
+        PERL_SCRIPT_REC *script;
 	int tag;
         int refcount;
-	char *func;
+
+	SV *func;
 	SV *data;
 } PERL_SOURCE_REC;
 
@@ -45,7 +47,7 @@ static void perl_source_unref(PERL_SOURCE_REC *rec)
 		return;
 
         SvREFCNT_dec(rec->data);
-	g_free(rec->func);
+        SvREFCNT_dec(rec->func);
 	g_free(rec);
 }
 
@@ -71,16 +73,13 @@ static int perl_source_event(PERL_SOURCE_REC *rec)
 	PUTBACK;
 
         perl_source_ref(rec);
-	perl_call_pv(rec->func, G_EVAL|G_DISCARD);
+	perl_call_sv(rec->func, G_EVAL|G_DISCARD);
 	SPAGAIN;
 
 	if (SvTRUE(ERRSV)) {
 		STRLEN n_a;
-                char *package;
 
-                package = perl_function_get_package(rec->func);
+		signal_emit("script error", 2, rec->script,
-		signal_emit("script error", 2,
-			    perl_script_find_package(package),
 			    SvPV(ERRSV, n_a));
                 g_free(package);
 	}
@@ -93,36 +92,46 @@ static int perl_source_event(PERL_SOURCE_REC *rec)
 	return 1;
 }
 
-int perl_timeout_add(int msecs, const char *func, SV *data)
+int perl_timeout_add(int msecs, SV *func, SV *data)
 {
+        PERL_SCRIPT_REC *script;
 	PERL_SOURCE_REC *rec;
+	const char *pkg;
+
+        pkg = perl_get_package();
+	script = perl_script_find_package(pkg);
+        g_return_val_if_fail(script != NULL, -1);
 
 	rec = g_new0(PERL_SOURCE_REC, 1);
 	perl_source_ref(rec);
 
-        SvREFCNT_inc(data);
+	rec->func = perl_func_sv_inc(func, pkg);
-	rec->data = data;
+	rec->data = SvREFCNT_inc(data);
-
-	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
 	rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
 
 	perl_sources = g_slist_append(perl_sources, rec);
 	return rec->tag;
 }
 
-int perl_input_add(int source, int condition, const char *func, SV *data)
+int perl_input_add(int source, int condition, SV *func, SV *data)
 {
+        PERL_SCRIPT_REC *script;
 	PERL_SOURCE_REC *rec;
-        GIOChannel *channel;
+	GIOChannel *channel;
+        const char *pkg;
+
+        pkg = perl_get_package();
+	script = perl_script_find_package(pkg);
+        g_return_val_if_fail(script != NULL, -1);
 
 	rec = g_new0(PERL_SOURCE_REC, 1);
 	perl_source_ref(rec);
 
-        SvREFCNT_inc(data);
+        rec->script =script;
-	rec->data = data;
+	rec->func = perl_func_sv_inc(func, pkg);
+	rec->data = SvREFCNT_inc(data);
 
-	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
+	channel = g_io_channel_unix_new(source);
-        channel = g_io_channel_unix_new(source);
 	rec->tag = g_input_add(channel, condition,
 			       (GInputFunction) perl_source_event, rec);
 	g_io_channel_unref(channel);
@@ -145,17 +154,15 @@ void perl_source_remove(int tag)
 	}
 }
 
-void perl_source_remove_package(const char *package)
+void perl_source_remove_script(PERL_SCRIPT_REC *script)
 {
 	GSList *tmp, *next;
-        int len;
 
-        len = strlen(package);
 	for (tmp = perl_sources; tmp != NULL; tmp = next) {
 		PERL_SOURCE_REC *rec = tmp->data;
 
 		next = tmp->next;
-		if (strncmp(rec->func, package, len) == 0)
+                if (rec->script == script)
 			perl_source_destroy(rec);
 	}
 }

src/perl/perl-sources.h

@@ -1,12 +1,12 @@
 #ifndef __PERL_SOURCES_H
 #define __PERL_SOURCES_H
 
-int perl_timeout_add(int msecs, const char *func, SV *data);
+int perl_timeout_add(int msecs, SV *func, SV *data);
-int perl_input_add(int source, int condition, const char *func, SV *data);
+int perl_input_add(int source, int condition, SV *func, SV *data);
 
 void perl_source_remove(int tag);
-/* remove all sources used by package */
+/* remove all sources used by script */
-void perl_source_remove_package(const char *package);
+void perl_source_remove_script(PERL_SCRIPT_REC *script);
 
 void perl_sources_start(void);
 void perl_sources_stop(void);