apps/irssi/src/perl/perl-signals.c

   1 /*
   2  perl-signals.c : irssi
   3
   4     Copyright (C) 1999-2001 Timo Sirainen
   5
   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.
  10
  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.
  15
  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
  19 */
  20
  21 #define NEED_PERL_H
  22 #include "module.h"
  23 #include "modules.h"
  24 #include "signals.h"
  25 #include "commands.h"
  26 #include "servers.h"
  27
  28 #include "perl-core.h"
  29 #include "perl-common.h"
  30 #include "perl-signals.h"
  31
  32 typedef struct {
  33         PERL_SCRIPT_REC *script;
  34         int signal_id;
  35         char *signal;
  36
  37         SV *func;
  38         int priority;
  39 } PERL_SIGNAL_REC;
  40
  41 typedef struct {
  42         char *signal;
  43         char *args[7];
  44 } PERL_SIGNAL_ARGS_REC;
  45
  46 #include "perl-signals-list.h"
  47
  48 static GHashTable *signals[3];
  49 static GHashTable *perl_signal_args_hash;
  50 static GSList *perl_signal_args_partial;
  51
  52 static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
  53 {
  54         PERL_SIGNAL_ARGS_REC *rec;
  55         GSList *tmp;
  56         const char *signame;
  57
  58         rec = g_hash_table_lookup(perl_signal_args_hash,
  59                                   GINT_TO_POINTER(signal_id));
  60         if (rec != NULL) return rec;
  61
  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) {
  65                 rec = tmp->data;
  66
  67                 if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0)
  68                         return rec;
  69         }
  70
  71         return NULL;
  72 }
  73
  74 static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
  75                              int signal_id, gconstpointer *args)
  76 {
  77         dSP;
  78
  79         PERL_SIGNAL_ARGS_REC *rec;
  80         SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
  81         AV *av;
  82         void *arg;
  83         int n;
  84
  85
  86         ENTER;
  87         SAVETMPS;
  88
  89         PUSHMARK(sp);
  90
  91         /* push signal argument to perl stack */
  92         rec = perl_signal_args_find(signal_id);
  93
  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];
  98
  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 */
 109                         GList *tmp, **ptr;
 110                         int is_iobject, is_str;
 111
 112                         is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
 113                         is_str = strcmp(rec->args[n]+9, "char*") == 0;
 114                         av = newAV();
 115
 116                         ptr = arg;
 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);
 121                                 av_push(av, sv);
 122                         }
 123
 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 */
 127                         GSList *tmp;
 128                         int is_iobject;
 129
 130                         is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
 131                         av = newAV();
 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);
 135                                 av_push(av, sv);
 136                         }
 137
 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);
 151                 } else {
 152                         /* blessed object */
 153                         perlarg = plain_bless(arg, rec->args[n]);
 154                 }
 155                 XPUSHs(sv_2mortal(perlarg));
 156         }
 157
 158         PUTBACK;
 159         perl_call_sv(func, G_EVAL|G_DISCARD);
 160         SPAGAIN;
 161
 162         if (SvTRUE(ERRSV)) {
 163                 char *error = g_strdup(SvPV(ERRSV, PL_na));
 164                 signal_emit("script error", 2, script, error);
 165                 g_free(error);
 166                 rec = NULL;
 167         }
 168
 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];
 173
 174                 if (saved_args[n] == NULL)
 175                         continue;
 176
 177                 if (strcmp(rec->args[n], "intptr") == 0) {
 178                         int *val = arg;
 179                         *val = SvIV(SvRV(saved_args[n]));
 180                 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 181                         GList **ret = arg;
 182                         GList *out = NULL;
 183                         void *val;
 184                         STRLEN len;
 185                         int count;
 186
 187                         av = (AV *) SvRV(saved_args[n]);
 188                         count = av_len(av);
 189                         while (count-- >= 0) {
 190                                 sv = av_shift(av);
 191                                 if (SvPOKp(sv))
 192                                         val = g_strdup(SvPV(sv, len));
 193                                 else
 194                                         val = GINT_TO_POINTER(SvIV(sv));
 195
 196                                 out = g_list_append(out, val);
 197                         }
 198
 199                         if (strcmp(rec->args[n]+9, "char*") == 0)
 200                                 g_list_foreach(*ret, (GFunc) g_free, NULL);
 201                         g_list_free(*ret);
 202                         *ret = out;
 203                 }
 204         }
 205
 206         PUTBACK;
 207         FREETMPS;
 208         LEAVE;
 209 }
 210
 211 static void sig_func(int priority, gconstpointer *args)
 212 {
 213         GSList **list, *tmp, *next;
 214         int signal_id;
 215
 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;
 221
 222                 next = tmp->next;
 223                 perl_call_signal(rec->script, rec->func, signal_id, args);
 224                 if (signal_is_stopped(signal_id))
 225                         break;
 226         }
 227 }
 228
 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) \
 233 { \
 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); \
 238 }
 239
 240 SIG_FUNC_DECL(0, first);
 241 SIG_FUNC_DECL(1, default);
 242 SIG_FUNC_DECL(2, last);
 243
 244 #define priority_get_func(priority) \
 245         (priority == 0 ? sig_func_first : \
 246         priority == 1 ? sig_func_default : sig_func_last)
 247
 248 #define perl_signal_get_func(rec) \
 249         (priority_get_func((rec)->priority))
 250
 251 static void perl_signal_add_to_int(const char *signal, SV *func,
 252                                    int priority, int command)
 253 {
 254         PERL_SCRIPT_REC *script;
 255         PERL_SIGNAL_REC *rec;
 256         GHashTable *table;
 257         GSList **siglist;
 258         void *signal_idp;
 259
 260         g_return_if_fail(signal != NULL);
 261         g_return_if_fail(func != NULL);
 262         g_return_if_fail(priority >= 0 && priority <= 2);
 263
 264         script = perl_script_find_package(perl_get_package());
 265         g_return_if_fail(script != NULL);
 266
 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));
 272                 command = TRUE;
 273         }
 274
 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;
 281
 282         table = signals[priority];
 283         signal_idp = GINT_TO_POINTER(rec->signal_id);
 284
 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);
 289
 290                 if (!command) {
 291                         signal_add_to_id(MODULE_NAME, priority, rec->signal_id,
 292                                          perl_signal_get_func(rec));
 293                 }
 294         }
 295
 296         *siglist = g_slist_append(*siglist, rec);
 297 }
 298
 299 void perl_signal_add_to(const char *signal, SV *func, int priority)
 300 {
 301         perl_signal_add_to_int(signal, func, priority, FALSE);
 302 }
 303
 304 static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
 305 {
 306         if (strncmp(rec->signal, "command ", 8) == 0)
 307                 command_unbind(rec->signal+8, perl_signal_get_func(rec));
 308
 309         SvREFCNT_dec(rec->func);
 310         g_free(rec->signal);
 311         g_free(rec);
 312 }
 313
 314 static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
 315 {
 316         void *signal_idp;
 317
 318         g_return_if_fail(rec != NULL);
 319
 320         signal_idp = GINT_TO_POINTER(rec->signal_id);
 321
 322         *siglist = g_slist_remove(*siglist, rec);
 323         if (*siglist == NULL) {
 324                 signal_remove_id(rec->signal_id, perl_signal_get_func(rec));
 325                 g_free(siglist);
 326                 g_hash_table_remove(signals[rec->priority], signal_idp);
 327         }
 328
 329         perl_signal_destroy(rec);
 330 }
 331
 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))
 335
 336 static void perl_signal_remove_list(GSList **list, SV *func)
 337 {
 338         GSList *tmp;
 339
 340         g_return_if_fail(list != NULL);
 341
 342         for (tmp = *list; tmp != NULL; tmp = tmp->next) {
 343                 PERL_SIGNAL_REC *rec = tmp->data;
 344
 345                 if (sv_func_cmp(rec->func, func, PL_na)) {
 346                         perl_signal_remove_list_one(list, rec);
 347                         break;
 348                 }
 349         }
 350 }
 351
 352 void perl_signal_remove(const char *signal, SV *func)
 353 {
 354         GSList **list;
 355         void *signal_idp;
 356         int n;
 357
 358         signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));
 359
 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);
 363                 if (list != NULL)
 364                         perl_signal_remove_list(list, func);
 365         }
 366         SvREFCNT_dec(func);
 367 }
 368
 369 void perl_command_bind_to(const char *cmd, const char *category,
 370                           SV *func, int priority)
 371 {
 372         char *signal;
 373
 374         command_bind_to(MODULE_NAME, priority, cmd, -1,
 375                         category, priority_get_func(priority));
 376
 377         signal = g_strconcat("command ", cmd, NULL);
 378         perl_signal_add_to_int(signal, func, priority, TRUE);
 379         g_free(signal);
 380 }
 381
 382 void perl_command_runsub(const char *cmd, const char *data,
 383                          SERVER_REC *server, WI_ITEM_REC *item)
 384 {
 385         command_runsub(cmd, data, server, item);
 386 }
 387
 388 void perl_command_unbind(const char *cmd, SV *func)
 389 {
 390         char *signal;
 391
 392         /* perl_signal_remove() calls command_unbind() */
 393         signal = g_strconcat("command ", cmd, NULL);
 394         perl_signal_remove(signal, func);
 395         g_free(signal);
 396 }
 397
 398 static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
 399 {
 400         GSList *tmp, *next;
 401
 402         for (tmp = *list; tmp != NULL; tmp = next) {
 403                 PERL_SIGNAL_REC *rec = tmp->data;
 404
 405                 next = tmp->next;
 406                 if (script == NULL || rec->script == script) {
 407                         *list = g_slist_remove(*list, rec);
 408                         if (*list == NULL) {
 409                                 signal_remove_id(rec->signal_id,
 410                                                  perl_signal_get_func(rec));
 411                         }
 412                         perl_signal_destroy(rec);
 413                 }
 414         }
 415
 416         if (*list != NULL)
 417                 return FALSE;
 418
 419         g_free(list);
 420         return TRUE;
 421 }
 422
 423 /* destroy all signals used by script */
 424 void perl_signal_remove_script(PERL_SCRIPT_REC *script)
 425 {
 426         int n;
 427
 428         for (n = 0; n < sizeof(signals)/sizeof(signals[0]); n++) {
 429                 g_hash_table_foreach_remove(signals[n],
 430                                             (GHRFunc) signal_destroy_hash,
 431                                             script);
 432         }
 433 }
 434
 435 void perl_signals_start(void)
 436 {
 437         int n;
 438
 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);
 442         }
 443 }
 444
 445 void perl_signals_stop(void)
 446 {
 447         int n;
 448
 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]);
 453                 signals[n] = NULL;
 454         }
 455 }
 456
 457 void perl_signals_init(void)
 458 {
 459         int n;
 460
 461         perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash,
 462                                                  (GCompareFunc) g_direct_equal);
 463         perl_signal_args_partial = NULL;
 464
 465         for (n = 0; perl_signal_args[n].signal != NULL; n++) {
 466                 PERL_SIGNAL_ARGS_REC *rec = &perl_signal_args[n];
 467
 468                 if (rec->signal[strlen(rec->signal)-1] == ' ') {
 469                         perl_signal_args_partial =
 470                                 g_slist_append(perl_signal_args_partial, rec);
 471                 } else {
 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),
 475                                             rec);
 476                 }
 477         }
 478 }
 479
 480 void perl_signals_deinit(void)
 481 {
 482         g_slist_free(perl_signal_args_partial);
 483         g_hash_table_destroy(perl_signal_args_hash);
 484 }