4 Copyright (C) 1999-2001 Timo Sirainen
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 #include "perl-core.h"
29 #include "perl-common.h"
30 #include "perl-signals.h"
33 PERL_SCRIPT_REC *script;
44 } PERL_SIGNAL_ARGS_REC;
46 #include "perl-signals-list.h"
48 static GHashTable *signals[3];
49 static GHashTable *perl_signal_args_hash;
50 static GSList *perl_signal_args_partial;
52 static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
54 PERL_SIGNAL_ARGS_REC *rec;
58 rec = g_hash_table_lookup(perl_signal_args_hash,
59 GINT_TO_POINTER(signal_id));
60 if (rec != NULL) return rec;
62 /* try to find by name */
63 signame = signal_get_id_str(signal_id);
64 for (tmp = perl_signal_args_partial; tmp != NULL; tmp = tmp->next) {
67 if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0)
74 static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
75 int signal_id, gconstpointer *args)
79 PERL_SIGNAL_ARGS_REC *rec;
80 SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
91 /* push signal argument to perl stack */
92 rec = perl_signal_args_find(signal_id);
94 memset(saved_args, 0, sizeof(saved_args));
95 for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
96 rec != NULL && rec->args[n] != NULL; n++) {
97 arg = (void *) args[n];
99 if (strcmp(rec->args[n], "string") == 0)
100 perlarg = new_pv(arg);
101 else if (strcmp(rec->args[n], "int") == 0)
102 perlarg = newSViv(GPOINTER_TO_INT(arg));
103 else if (strcmp(rec->args[n], "ulongptr") == 0)
104 perlarg = newSViv(*(unsigned long *) arg);
105 else if (strcmp(rec->args[n], "intptr") == 0)
106 saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg));
107 else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
108 /* pointer to linked list - push as AV */
110 int is_iobject, is_str;
112 is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
113 is_str = strcmp(rec->args[n]+9, "char*") == 0;
117 for (tmp = *ptr; tmp != NULL; tmp = tmp->next) {
118 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
119 is_str ? new_pv(tmp->data) :
120 irssi_bless_plain(rec->args[n]+9, tmp->data);
124 saved_args[n] = perlarg = newRV_noinc((SV *) av);
125 } else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
126 /* linked list - push as AV */
130 is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
132 for (tmp = arg; tmp != NULL; tmp = tmp->next) {
133 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
134 irssi_bless_plain(rec->args[n]+7, tmp->data);
138 perlarg = newRV_noinc((SV *) av);
139 } else if (arg == NULL) {
140 /* don't bless NULL arguments */
141 perlarg = newSViv(0);
142 } else if (strcmp(rec->args[n], "iobject") == 0) {
143 /* "irssi object" - any struct that has
144 "int type; int chat_type" as it's first
145 variables (server, channel, ..) */
146 perlarg = iobject_bless((SERVER_REC *) arg);
147 } else if (strcmp(rec->args[n], "siobject") == 0) {
148 /* "simple irssi object" - any struct that has
149 int type; as it's first variable (dcc) */
150 perlarg = simple_iobject_bless((SERVER_REC *) arg);
153 perlarg = plain_bless(arg, rec->args[n]);
155 XPUSHs(sv_2mortal(perlarg));
159 perl_call_sv(func, G_EVAL|G_DISCARD);
163 char *error = g_strdup(SvPV(ERRSV, PL_na));
164 signal_emit("script error", 2, script, error);
169 /* restore arguments the perl script modified */
170 for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
171 rec != NULL && rec->args[n] != NULL; n++) {
172 arg = (void *) args[n];
174 if (saved_args[n] == NULL)
177 if (strcmp(rec->args[n], "intptr") == 0) {
179 *val = SvIV(SvRV(saved_args[n]));
180 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
187 av = (AV *) SvRV(saved_args[n]);
189 while (count-- >= 0) {
192 val = g_strdup(SvPV(sv, len));
194 val = GINT_TO_POINTER(SvIV(sv));
196 out = g_list_append(out, val);
199 if (strcmp(rec->args[n]+9, "char*") == 0)
200 g_list_foreach(*ret, (GFunc) g_free, NULL);
211 static void sig_func(int priority, gconstpointer *args)
213 GSList **list, *tmp, *next;
216 signal_id = signal_get_emitted_id();
217 list = g_hash_table_lookup(signals[priority],
218 GINT_TO_POINTER(signal_id));
219 for (tmp = list == NULL ? NULL : *list; tmp != NULL; tmp = next) {
220 PERL_SIGNAL_REC *rec = tmp->data;
223 perl_call_signal(rec->script, rec->func, signal_id, args);
224 if (signal_is_stopped(signal_id))
229 #define SIG_FUNC_DECL(priority, priority_name) \
230 static void sig_func_##priority_name(gconstpointer p1, gconstpointer p2, \
231 gconstpointer p3, gconstpointer p4, \
232 gconstpointer p5, gconstpointer p6) \
234 gconstpointer args[6]; \
235 args[0] = p1; args[1] = p2; args[2] = p3; \
236 args[3] = p4; args[4] = p5; args[5] = p6; \
237 sig_func(priority, args); \
240 SIG_FUNC_DECL(0, first);
241 SIG_FUNC_DECL(1, default);
242 SIG_FUNC_DECL(2, last);
244 #define priority_get_func(priority) \
245 (priority == 0 ? sig_func_first : \
246 priority == 1 ? sig_func_default : sig_func_last)
248 #define perl_signal_get_func(rec) \
249 (priority_get_func((rec)->priority))
251 static void perl_signal_add_to_int(const char *signal, SV *func,
252 int priority, int command)
254 PERL_SCRIPT_REC *script;
255 PERL_SIGNAL_REC *rec;
260 g_return_if_fail(signal != NULL);
261 g_return_if_fail(func != NULL);
262 g_return_if_fail(priority >= 0 && priority <= 2);
264 script = perl_script_find_package(perl_get_package());
265 g_return_if_fail(script != NULL);
267 if (!command && strncmp(signal, "command ", 8) == 0) {
268 /* we used Irssi::signal_add() instead of
269 Irssi::command_bind() - oh well, allow this.. */
270 command_bind_to(MODULE_NAME, priority, signal+8, -1,
271 NULL, priority_get_func(priority));
275 rec = g_new(PERL_SIGNAL_REC, 1);
276 rec->script = script;
277 rec->signal_id = signal_get_uniq_id(signal);
278 rec->signal = g_strdup(signal);
279 rec->func = perl_func_sv_inc(func, perl_get_package());
280 rec->priority = priority;
282 table = signals[priority];
283 signal_idp = GINT_TO_POINTER(rec->signal_id);
285 siglist = g_hash_table_lookup(table, signal_idp);
286 if (siglist == NULL) {
287 siglist = g_new0(GSList *, 1);
288 g_hash_table_insert(table, signal_idp, siglist);
291 signal_add_to_id(MODULE_NAME, priority, rec->signal_id,
292 perl_signal_get_func(rec));
296 *siglist = g_slist_append(*siglist, rec);
299 void perl_signal_add_to(const char *signal, SV *func, int priority)
301 perl_signal_add_to_int(signal, func, priority, FALSE);
304 static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
306 if (strncmp(rec->signal, "command ", 8) == 0)
307 command_unbind(rec->signal+8, perl_signal_get_func(rec));
309 SvREFCNT_dec(rec->func);
314 static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
318 g_return_if_fail(rec != NULL);
320 signal_idp = GINT_TO_POINTER(rec->signal_id);
322 *siglist = g_slist_remove(*siglist, rec);
323 if (*siglist == NULL) {
324 signal_remove_id(rec->signal_id, perl_signal_get_func(rec));
326 g_hash_table_remove(signals[rec->priority], signal_idp);
329 perl_signal_destroy(rec);
332 #define sv_func_cmp(f1, f2, len) \
333 (f1 == f2 || (SvPOK(f1) && SvPOK(f2) && \
334 strcmp((char *) SvPV(f1, len), (char *) SvPV(f2, len)) == 0))
336 static void perl_signal_remove_list(GSList **list, SV *func)
340 g_return_if_fail(list != NULL);
342 for (tmp = *list; tmp != NULL; tmp = tmp->next) {
343 PERL_SIGNAL_REC *rec = tmp->data;
345 if (sv_func_cmp(rec->func, func, PL_na)) {
346 perl_signal_remove_list_one(list, rec);
352 void perl_signal_remove(const char *signal, SV *func)
358 signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));
360 func = perl_func_sv_inc(func, perl_get_package());
361 for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
362 list = g_hash_table_lookup(signals[n], signal_idp);
364 perl_signal_remove_list(list, func);
369 void perl_command_bind_to(const char *cmd, const char *category,
370 SV *func, int priority)
374 command_bind_to(MODULE_NAME, priority, cmd, -1,
375 category, priority_get_func(priority));
377 signal = g_strconcat("command ", cmd, NULL);
378 perl_signal_add_to_int(signal, func, priority, TRUE);
382 void perl_command_runsub(const char *cmd, const char *data,
383 SERVER_REC *server, WI_ITEM_REC *item)
385 command_runsub(cmd, data, server, item);
388 void perl_command_unbind(const char *cmd, SV *func)
392 /* perl_signal_remove() calls command_unbind() */
393 signal = g_strconcat("command ", cmd, NULL);
394 perl_signal_remove(signal, func);
398 static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
402 for (tmp = *list; tmp != NULL; tmp = next) {
403 PERL_SIGNAL_REC *rec = tmp->data;
406 if (script == NULL || rec->script == script) {
407 *list = g_slist_remove(*list, rec);
409 signal_remove_id(rec->signal_id,
410 perl_signal_get_func(rec));
412 perl_signal_destroy(rec);
423 /* destroy all signals used by script */
424 void perl_signal_remove_script(PERL_SCRIPT_REC *script)
428 for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
429 g_hash_table_foreach_remove(signals[n],
430 (GHRFunc) signal_destroy_hash,
435 void perl_signals_start(void)
439 for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
440 signals[n] = g_hash_table_new((GHashFunc) g_direct_hash,
441 (GCompareFunc) g_direct_equal);
445 void perl_signals_stop(void)
449 for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
450 g_hash_table_foreach(signals[n],
451 (GHFunc) signal_destroy_hash, NULL);
452 g_hash_table_destroy(signals[n]);
457 void perl_signals_init(void)
461 perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash,
462 (GCompareFunc) g_direct_equal);
463 perl_signal_args_partial = NULL;
465 for (n = 0; perl_signal_args[n].signal != NULL; n++) {
466 PERL_SIGNAL_ARGS_REC *rec = &perl_signal_args[n];
468 if (rec->signal[strlen(rec->signal)-1] == ' ') {
469 perl_signal_args_partial =
470 g_slist_append(perl_signal_args_partial, rec);
472 int signal_id = signal_get_uniq_id(rec->signal);
473 g_hash_table_insert(perl_signal_args_hash,
474 GINT_TO_POINTER(signal_id),
480 void perl_signals_deinit(void)
482 g_slist_free(perl_signal_args_partial);
483 g_hash_table_destroy(perl_signal_args_hash);