Script name is printed now correctly if there's an error in

timeouts/signals.


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

5 files changed, 66 insertions, 9 deletions

diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c
index dc3c3f0e..a7ac9fcd 100644
--- a/src/perl/perl-common.c
+++ b/src/perl/perl-common.c
@@ -50,12 +50,29 @@ static GHashTable *iobject_stashes, *plain_stashes;
 static GSList *use_protocols;
 
 /* returns the package who called us */
-char *perl_get_package(void)
+const char *perl_get_package(void)
 {
 	STRLEN n_a;
 	return SvPV(perl_eval_pv("caller", TRUE), n_a);
 }
 
+/* Parses the package part from function name */
+char *perl_function_get_package(const char *function)
+{
+	const char *p;
+        int pos;
+
+        pos = 0;
+	for (p = function; *p != '\0'; p++) {
+		if (*p == ':' && p[1] == ':') {
+			if (++pos == 3)
+                                return g_strndup(function, (int) (p-function));
+		}
+	}
+
+        return NULL;
+}
+
 SV *irssi_bless_iobject(int type, int chat_type, void *object)
 {
         PERL_OBJECT_REC *rec;
diff --git a/src/perl/perl-common.h b/src/perl/perl-common.h
index 81b4489d..232d7510 100644
--- a/src/perl/perl-common.h
+++ b/src/perl/perl-common.h
@@ -18,8 +18,10 @@ typedef struct {
         PERL_OBJECT_FUNC fill_func;
 } PLAIN_OBJECT_INIT_REC;
 
-/* returns the package who called us */
-char *perl_get_package(void);
+/* Returns the package who called us */
+const char *perl_get_package(void);
+/* Parses the package part from function name */
+char *perl_function_get_package(const char *function);
 
 /* For compatibility with perl 5.004 and older */
 #ifndef HAVE_PL_PERL
diff --git a/src/perl/perl-core.c b/src/perl/perl-core.c
index 88be92e1..8b23c7fe 100644
--- a/src/perl/perl-core.c
+++ b/src/perl/perl-core.c
@@ -124,7 +124,9 @@ void perl_scripts_deinit(void)
 /* Unload perl script */
 void perl_script_unload(PERL_SCRIPT_REC *script)
 {
-        perl_script_destroy_package(script);
+        g_return_if_fail(script != NULL);
+
+	perl_script_destroy_package(script);
         perl_script_destroy(script);
 }
 
@@ -240,6 +242,8 @@ PERL_SCRIPT_REC *perl_script_load_file(const char *path)
 {
 	char *name;
 
+        g_return_val_if_fail(path != NULL, NULL);
+
         name = script_file_get_name(path);
         return script_load(name, path, NULL);
 }
@@ -249,6 +253,8 @@ PERL_SCRIPT_REC *perl_script_load_data(const char *data)
 {
 	char *name;
 
+        g_return_val_if_fail(data != NULL, NULL);
+
 	name = script_data_get_name();
 	return script_load(name, NULL, data);
 }
@@ -258,6 +264,8 @@ PERL_SCRIPT_REC *perl_script_find(const char *name)
 {
 	GSList *tmp;
 
+        g_return_val_if_fail(name != NULL, NULL);
+
 	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
 		PERL_SCRIPT_REC *rec = tmp->data;
 
@@ -273,6 +281,8 @@ PERL_SCRIPT_REC *perl_script_find_package(const char *package)
 {
 	GSList *tmp;
 
+        g_return_val_if_fail(package != NULL, NULL);
+
 	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
 		PERL_SCRIPT_REC *rec = tmp->data;
 
diff --git a/src/perl/perl-signals.c b/src/perl/perl-signals.c
index 520bbd60..0fc00b6f 100644
--- a/src/perl/perl-signals.c
+++ b/src/perl/perl-signals.c
@@ -157,10 +157,13 @@ static void perl_call_signal(const char *func, int signal_id,
 
 	if (SvTRUE(ERRSV)) {
 		STRLEN n_a;
+                char *package;
 
+                package = perl_function_get_package(func);
 		signal_emit("script error", 2,
-			    perl_script_find_package(perl_get_package()),
+			    perl_script_find_package(package),
 			    SvPV(ERRSV, n_a));
+                g_free(package);
 	}
 
         /* restore arguments the perl script modified */
diff --git a/src/perl/perl-sources.c b/src/perl/perl-sources.c
index a16e87f9..7b263bcb 100644
--- a/src/perl/perl-sources.c
+++ b/src/perl/perl-sources.c
@@ -27,22 +27,38 @@
 
 typedef struct {
 	int tag;
+        int refcount;
 	char *func;
 	char *data;
 } PERL_SOURCE_REC;
 
 static GSList *perl_sources;
 
-static void perl_source_destroy(PERL_SOURCE_REC *rec)
+static void perl_source_ref(PERL_SOURCE_REC *rec)
 {
-	perl_sources = g_slist_remove(perl_sources, rec);
+        rec->refcount++;
+}
+
+static void perl_source_unref(PERL_SOURCE_REC *rec)
+{
+	if (--rec->refcount != 0)
+		return;
 
-	g_source_remove(rec->tag);
 	g_free(rec->func);
 	g_free(rec->data);
 	g_free(rec);
 }
 
+static void perl_source_destroy(PERL_SOURCE_REC *rec)
+{
+	perl_sources = g_slist_remove(perl_sources, rec);
+
+	g_source_remove(rec->tag);
+	rec->tag = -1;
+
+	perl_source_unref(rec);
+}
+
 static int perl_source_event(PERL_SOURCE_REC *rec)
 {
 	dSP;
@@ -55,16 +71,21 @@ static int perl_source_event(PERL_SOURCE_REC *rec)
 	XPUSHs(sv_2mortal(new_pv(rec->data)));
 	PUTBACK;
 
+        perl_source_ref(rec);
 	retcount = perl_call_pv(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,
-			    perl_script_find_package(perl_get_package()),
+			    perl_script_find_package(package),
 			    SvPV(ERRSV, n_a));
+                g_free(package);
 	}
+        perl_source_unref(rec);
 
 	PUTBACK;
 	FREETMPS;
@@ -78,6 +99,8 @@ int perl_timeout_add(int msecs, const char *func, const char *data)
 	PERL_SOURCE_REC *rec;
 
 	rec = g_new(PERL_SOURCE_REC, 1);
+	perl_source_ref(rec);
+
 	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
 	rec->data = g_strdup(data);
 	rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
@@ -93,6 +116,8 @@ int perl_input_add(int source, int condition,
         GIOChannel *channel;
 
 	rec = g_new(PERL_SOURCE_REC, 1);
+	perl_source_ref(rec);
+
 	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
 	rec->data = g_strdup(data);