aniani/irssi
1
0
Fork 0
mirror of https://github.com/irssi/irssi.git synced 2024-12-04 14:46:39 -05:00
Code

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

Browse Source 
timeouts/signals.


git-svn-id: http://svn.irssi.org/repos/irssi/trunk@1688 dbcabf3a-b0e7-0310-adc4-f8d773084564
This commit is contained in:
Timo Sirainen 2001-07-30 12:56:57 +00:00 committed by cras
parent 279f149295
commit 82034efb11
5 changed files with 66 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/perl/perl-common.c
View File

@ -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;

6
src/perl/perl-common.h
View File

@ -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

10
src/perl/perl-core.c
View File

@ -124,6 +124,8 @@ void perl_scripts_deinit(void)
/* Unload perl script */
void perl_script_unload(PERL_SCRIPT_REC *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;

5
src/perl/perl-signals.c
View File

@ -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 */

33
src/perl/perl-sources.c
View File

@ -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);