1
0
mirror of https://github.com/irssi/irssi.git synced 2024-11-03 04:27:19 -05:00
irssi/src/perl/perl-signals.c
Timo Sirainen 7131ceb909 g_strdup() the error message before emitting "script error" signal, since
perl scripting might be executed during that signal and it clears the error
message.


git-svn-id: http://svn.irssi.org/repos/irssi/trunk@2302 dbcabf3a-b0e7-0310-adc4-f8d773084564
2002-01-10 17:36:41 +00:00

485 lines
12 KiB
C

/*
perl-signals.c : irssi
Copyright (C) 1999-2001 Timo Sirainen
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define NEED_PERL_H
#include "module.h"
#include "modules.h"
#include "signals.h"
#include "commands.h"
#include "servers.h"
#include "perl-core.h"
#include "perl-common.h"
#include "perl-signals.h"
typedef struct {
PERL_SCRIPT_REC *script;
int signal_id;
char *signal;
SV *func;
int priority;
} PERL_SIGNAL_REC;
typedef struct {
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 void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
int signal_id, gconstpointer *args)
{
dSP;
PERL_SIGNAL_ARGS_REC *rec;
SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
AV *av;
void *arg;
int n;
ENTER;
SAVETMPS;
PUSHMARK(sp);
/* push signal argument to perl stack */
rec = perl_signal_args_find(signal_id);
memset(saved_args, 0, sizeof(saved_args));
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 (strcmp(rec->args[n], "intptr") == 0)
saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg));
else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
/* pointer to linked list - push as AV */
GList *tmp, **ptr;
int is_iobject, is_str;
is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
is_str = strcmp(rec->args[n]+9, "char*") == 0;
av = newAV();
ptr = arg;
for (tmp = *ptr; tmp != NULL; tmp = tmp->next) {
sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
is_str ? new_pv(tmp->data) :
irssi_bless_plain(rec->args[n]+9, tmp->data);
av_push(av, sv);
}
saved_args[n] = perlarg = newRV_noinc((SV *) av);
} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
/* linked list - push as AV */
GSList *tmp;
int is_iobject;
is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
av = newAV();
for (tmp = arg; tmp != NULL; tmp = tmp->next) {
sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
irssi_bless_plain(rec->args[n]+7, tmp->data);
av_push(av, sv);
}
perlarg = newRV_noinc((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 it's first
variables (server, channel, ..) */
perlarg = iobject_bless((SERVER_REC *) arg);
} else if (strcmp(rec->args[n], "siobject") == 0) {
/* "simple irssi object" - any struct that has
int type; as it's first variable (dcc) */
perlarg = simple_iobject_bless((SERVER_REC *) arg);
} else {
/* blessed object */
perlarg = plain_bless(arg, rec->args[n]);
}
XPUSHs(sv_2mortal(perlarg));
}
PUTBACK;
perl_call_sv(func, G_EVAL|G_DISCARD);
SPAGAIN;
if (SvTRUE(ERRSV)) {
char *error = g_strdup(SvPV(ERRSV, PL_na));
signal_emit("script error", 2, script, error);
g_free(error);
rec = NULL;
}
/* restore arguments the perl script modified */
for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
rec != NULL && rec->args[n] != NULL; n++) {
arg = (void *) args[n];
if (saved_args[n] == NULL)
continue;
if (strcmp(rec->args[n], "intptr") == 0) {
int *val = arg;
*val = SvIV(SvRV(saved_args[n]));
} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
GList **ret = arg;
GList *out = NULL;
void *val;
STRLEN len;
int count;
av = (AV *) SvRV(saved_args[n]);
count = av_len(av);
while (count-- >= 0) {
sv = av_shift(av);
if (SvPOKp(sv))
val = g_strdup(SvPV(sv, len));
else
val = GINT_TO_POINTER(SvIV(sv));
out = g_list_append(out, val);
}
if (strcmp(rec->args[n]+9, "char*") == 0)
g_list_foreach(*ret, (GFunc) g_free, NULL);
g_list_free(*ret);
*ret = out;
}
}
PUTBACK;
FREETMPS;
LEAVE;
}
static void sig_func(int priority, gconstpointer *args)
{
GSList **list, *tmp, *next;
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 = next) {
PERL_SIGNAL_REC *rec = tmp->data;
next = tmp->next;
perl_call_signal(rec->script, rec->func, signal_id, args);
if (signal_is_stopped(signal_id))
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 priority_get_func(priority) \
(priority == 0 ? sig_func_first : \
priority == 1 ? sig_func_default : sig_func_last)
#define perl_signal_get_func(rec) \
(priority_get_func((rec)->priority))
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;
void *signal_idp;
g_return_if_fail(signal != NULL);
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.. */
command_bind_to(MODULE_NAME, priority, signal+8, -1,
NULL, priority_get_func(priority));
command = TRUE;
}
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 = perl_func_sv_inc(func, perl_get_package());
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);
if (!command) {
signal_add_to_id(MODULE_NAME, priority, rec->signal_id,
perl_signal_get_func(rec));
}
}
*siglist = g_slist_append(*siglist, rec);
}
void perl_signal_add_to(const char *signal, SV *func, int priority)
{
perl_signal_add_to_int(signal, func, priority, FALSE);
}
static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
{
if (strncmp(rec->signal, "command ", 8) == 0)
command_unbind(rec->signal+8, perl_signal_get_func(rec));
SvREFCNT_dec(rec->func);
g_free(rec->signal);
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);
}
#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;
g_return_if_fail(list != NULL);
for (tmp = *list; tmp != NULL; tmp = tmp->next) {
PERL_SIGNAL_REC *rec = tmp->data;
if (sv_func_cmp(rec->func, func, PL_na)) {
perl_signal_remove_list_one(list, rec);
break;
}
}
}
void perl_signal_remove(const char *signal, SV *func)
{
GSList **list;
void *signal_idp;
int n;
signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));
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, func);
}
SvREFCNT_dec(func);
}
void perl_command_bind_to(const char *cmd, const char *category,
SV *func, int priority)
{
char *signal;
command_bind_to(MODULE_NAME, priority, cmd, -1,
category, priority_get_func(priority));
signal = g_strconcat("command ", cmd, NULL);
perl_signal_add_to_int(signal, func, priority, TRUE);
g_free(signal);
}
void perl_command_runsub(const char *cmd, const char *data,
SERVER_REC *server, WI_ITEM_REC *item)
{
command_runsub(cmd, data, server, item);
}
void perl_command_unbind(const char *cmd, SV *func)
{
char *signal;
/* perl_signal_remove() calls command_unbind() */
signal = g_strconcat("command ", cmd, NULL);
perl_signal_remove(signal, func);
g_free(signal);
}
static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
{
GSList *tmp, *next;
for (tmp = *list; tmp != NULL; tmp = next) {
PERL_SIGNAL_REC *rec = tmp->data;
next = tmp->next;
if (script == NULL || rec->script == script) {
*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 script */
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,
script);
}
}
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]);
signals[n] = NULL;
}
}
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 {
int signal_id = signal_get_uniq_id(rec->signal);
g_hash_table_insert(perl_signal_args_hash,
GINT_TO_POINTER(signal_id),
rec);
}
}
}
void perl_signals_deinit(void)
{
g_slist_free(perl_signal_args_partial);
g_hash_table_destroy(perl_signal_args_hash);
}