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,20 +27,36 @@ typedef struct { int tag; + int refcount; char *func; char *data; } PERL_SOURCE_REC; static GSList *perl_sources; +static void perl_source_ref(PERL_SOURCE_REC *rec) +{ + rec->refcount++; +} + +static void perl_source_unref(PERL_SOURCE_REC *rec) +{ + if (--rec->refcount != 0) + return; + + 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); - g_free(rec->func); - g_free(rec->data); - g_free(rec); + rec->tag = -1; + + perl_source_unref(rec); } static int perl_source_event(PERL_SOURCE_REC *rec) @@ -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);