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         SV *func;
  37 } PERL_SIGNAL_REC;
  38
  39 typedef struct {
  40         char *signal;
  41         char *args[7];
  42         int dynamic;
  43 } PERL_SIGNAL_ARGS_REC;
  44
  45 #include "perl-signals-list.h"
  46
  47 static GHashTable *signals;
  48 static GHashTable *perl_signal_args_hash;
  49 static GSList *perl_signal_args_partial;
  50
  51 static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
  52 {
  53         PERL_SIGNAL_ARGS_REC *rec;
  54         GSList *tmp;
  55         const char *signame;
  56
  57         rec = g_hash_table_lookup(perl_signal_args_hash,
  58                                   GINT_TO_POINTER(signal_id));
  59         if (rec != NULL) return rec;
  60
  61         /* try to find by name */
  62         signame = signal_get_id_str(signal_id);
  63         for (tmp = perl_signal_args_partial; tmp != NULL; tmp = tmp->next) {
  64                 rec = tmp->data;
  65
  66                 if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0)
  67                         return rec;
  68         }
  69
  70         return NULL;
  71 }
  72
  73 static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
  74                              int signal_id, gconstpointer *args)
  75 {
  76         dSP;
  77
  78         PERL_SIGNAL_ARGS_REC *rec;
  79         SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
  80         AV *av;
  81         void *arg;
  82         int n;
  83
  84
  85         ENTER;
  86         SAVETMPS;
  87
  88         PUSHMARK(sp);
  89
  90         /* push signal argument to perl stack */
  91         rec = perl_signal_args_find(signal_id);
  92
  93         memset(saved_args, 0, sizeof(saved_args));
  94         for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
  95                     rec != NULL && rec->args[n] != NULL; n++) {
  96                 arg = (void *) args[n];
  97
  98                 if (strcmp(rec->args[n], "string") == 0)
  99                         perlarg = new_pv(arg);
 100                 else if (strcmp(rec->args[n], "int") == 0)
 101                         perlarg = newSViv((IV)arg);
 102                 else if (strcmp(rec->args[n], "ulongptr") == 0)
 103                         perlarg = newSViv(*(unsigned long *) arg);
 104                 else if (strcmp(rec->args[n], "intptr") == 0)
 105                         saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg));
 106                 else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 107                         /* pointer to linked list - push as AV */
 108                         GList *tmp, **ptr;
 109                         int is_iobject, is_str;
 110
 111                         is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
 112                         is_str = strcmp(rec->args[n]+9, "char*") == 0;
 113                         av = newAV();
 114
 115                         ptr = arg;
 116                         for (tmp = *ptr; tmp != NULL; tmp = tmp->next) {
 117                                 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
 118                                         is_str ? new_pv(tmp->data) :
 119                                         irssi_bless_plain(rec->args[n]+9, tmp->data);
 120                                 av_push(av, sv);
 121                         }
 122
 123                         saved_args[n] = perlarg = newRV_noinc((SV *) av);
 124                 } else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
 125                         /* linked list - push as AV */
 126                         GSList *tmp;
 127                         int is_iobject;
 128
 129                         is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
 130                         av = newAV();
 131                         for (tmp = arg; tmp != NULL; tmp = tmp->next) {
 132                                 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
 133                                         irssi_bless_plain(rec->args[n]+7, tmp->data);
 134                                 av_push(av, sv);
 135                         }
 136
 137                         perlarg = newRV_noinc((SV *) av);
 138                 } else if (arg == NULL) {
 139                         /* don't bless NULL arguments */
 140                         perlarg = newSViv(0);
 141                 } else if (strcmp(rec->args[n], "iobject") == 0) {
 142                         /* "irssi object" - any struct that has
 143                            "int type; int chat_type" as it's first
 144                            variables (server, channel, ..) */
 145                         perlarg = iobject_bless((SERVER_REC *) arg);
 146                 } else if (strcmp(rec->args[n], "siobject") == 0) {
 147                         /* "simple irssi object" - any struct that has
 148                            int type; as it's first variable (dcc) */
 149                         perlarg = simple_iobject_bless((SERVER_REC *) arg);
 150                 } else {
 151                         /* blessed object */
 152                         perlarg = plain_bless(arg, rec->args[n]);
 153                 }
 154                 XPUSHs(sv_2mortal(perlarg));
 155         }
 156
 157         PUTBACK;
 158         perl_call_sv(func, G_EVAL|G_DISCARD);
 159         SPAGAIN;
 160
 161         if (SvTRUE(ERRSV)) {
 162                 char *error = g_strdup(SvPV(ERRSV, PL_na));
 163                 signal_emit("script error", 2, script, error);
 164                 g_free(error);
 165                 rec = NULL;
 166         }
 167
 168         /* restore arguments the perl script modified */
 169         for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
 170                     rec != NULL && rec->args[n] != NULL; n++) {
 171                 arg = (void *) args[n];
 172
 173                 if (saved_args[n] == NULL)
 174                         continue;
 175
 176                 if (strcmp(rec->args[n], "intptr") == 0) {
 177                         int *val = arg;
 178                         *val = SvIV(SvRV(saved_args[n]));
 179                 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 180                         GList **ret = arg;
 181                         GList *out = NULL;
 182                         void *val;
 183                         STRLEN len;
 184                         int count;
 185
 186                         av = (AV *) SvRV(saved_args[n]);
 187                         count = av_len(av);
 188                         while (count-- >= 0) {
 189                                 sv = av_shift(av);
 190                                 if (SvPOKp(sv))
 191                                         val = g_strdup(SvPV(sv, len));
 192                                 else
 193                                         val = GINT_TO_POINTER(SvIV(sv));
 194
 195                                 out = g_list_append(out, val);
 196                         }
 197
 198                         if (strcmp(rec->args[n]+9, "char*") == 0)
 199                                 g_list_foreach(*ret, (GFunc) g_free, NULL);
 200                         g_list_free(*ret);
 201                         *ret = out;
 202                 }
 203         }
 204
 205         PUTBACK;
 206         FREETMPS;
 207         LEAVE;
 208 }
 209
 210 static void sig_func(const void *p1, const void *p2,
 211                      const void *p3, const void *p4,
 212                      const void *p5, const void *p6)
 213 {
 214         PERL_SIGNAL_REC *rec;
 215         const void *args[6];
 216
 217         args[0] = p1; args[1] = p2; args[2] = p3;
 218         args[3] = p4; args[4] = p5; args[5] = p6;
 219
 220         rec = signal_get_user_data();
 221         perl_call_signal(rec->script, rec->func, signal_get_emitted_id(), args);
 222 }
 223
 224 static void perl_signal_add_full_int(const char *signal, SV *func,
 225                                      int priority, int command,
 226                                      const char *category)
 227 {
 228         PERL_SCRIPT_REC *script;
 229         PERL_SIGNAL_REC *rec;
 230         GSList **siglist;
 231         void *signal_idp;
 232
 233         g_return_if_fail(signal != NULL);
 234         g_return_if_fail(func != NULL);
 235
 236         script = perl_script_find_package(perl_get_package());
 237         g_return_if_fail(script != NULL);
 238
 239         rec = g_new(PERL_SIGNAL_REC, 1);
 240         rec->script = script;
 241         rec->signal_id = signal_get_uniq_id(signal);
 242         rec->signal = g_strdup(signal);
 243         rec->func = perl_func_sv_inc(func, perl_get_package());
 244
 245         if (command || strncmp(signal, "command ", 8) == 0) {
 246                 /* we used Irssi::signal_add() instead of
 247                    Irssi::command_bind() - oh well, allow this.. */
 248                 command_bind_full(MODULE_NAME, priority, signal+8, -1,
 249                                   category, sig_func, rec);
 250         } else {
 251                 signal_add_full_id(MODULE_NAME, priority, rec->signal_id,
 252                                    sig_func, rec);
 253         }
 254
 255         signal_idp = GINT_TO_POINTER(rec->signal_id);
 256         siglist = g_hash_table_lookup(signals, signal_idp);
 257         if (siglist == NULL) {
 258                 siglist = g_new0(GSList *, 1);
 259                 g_hash_table_insert(signals, signal_idp, siglist);
 260         }
 261
 262         *siglist = g_slist_append(*siglist, rec);
 263 }
 264
 265 void perl_signal_add_full(const char *signal, SV *func, int priority)
 266 {
 267         perl_signal_add_full_int(signal, func, priority, FALSE, NULL);
 268 }
 269
 270 static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
 271 {
 272         if (strncmp(rec->signal, "command ", 8) == 0)
 273                 command_unbind_full(rec->signal+8, sig_func, rec);
 274         else
 275                 signal_remove_id(rec->signal_id, sig_func, rec);
 276
 277         SvREFCNT_dec(rec->func);
 278         g_free(rec->signal);
 279         g_free(rec);
 280 }
 281
 282 static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
 283 {
 284         *siglist = g_slist_remove(*siglist, rec);
 285         if (*siglist == NULL) {
 286                 g_free(siglist);
 287                 g_hash_table_remove(signals, GINT_TO_POINTER(rec->signal_id));
 288         }
 289
 290         perl_signal_destroy(rec);
 291 }
 292
 293 #define sv_func_cmp(f1, f2, len) \
 294         (f1 == f2 || (SvPOK(f1) && SvPOK(f2) && \
 295                 strcmp((char *) SvPV(f1, len), (char *) SvPV(f2, len)) == 0))
 296
 297 static void perl_signal_remove_list(GSList **list, SV *func)
 298 {
 299         GSList *tmp;
 300
 301         for (tmp = *list; tmp != NULL; tmp = tmp->next) {
 302                 PERL_SIGNAL_REC *rec = tmp->data;
 303
 304                 if (sv_func_cmp(rec->func, func, PL_na)) {
 305                         perl_signal_remove_list_one(list, rec);
 306                         break;
 307                 }
 308         }
 309 }
 310
 311 void perl_signal_remove(const char *signal, SV *func)
 312 {
 313         GSList **list;
 314         void *signal_idp;
 315
 316         signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));
 317         list = g_hash_table_lookup(signals, signal_idp);
 318
 319         if (list != NULL) {
 320                 func = perl_func_sv_inc(func, perl_get_package());
 321                 perl_signal_remove_list(list, func);
 322                 SvREFCNT_dec(func);
 323         }
 324 }
 325
 326 void perl_command_bind_to(const char *cmd, const char *category,
 327                           SV *func, int priority)
 328 {
 329         char *signal;
 330
 331         signal = g_strconcat("command ", cmd, NULL);
 332         perl_signal_add_full_int(signal, func, priority, TRUE, category);
 333         g_free(signal);
 334 }
 335
 336 void perl_command_runsub(const char *cmd, const char *data,
 337                          SERVER_REC *server, WI_ITEM_REC *item)
 338 {
 339         command_runsub(cmd, data, server, item);
 340 }
 341
 342 void perl_command_unbind(const char *cmd, SV *func)
 343 {
 344         char *signal;
 345
 346         /* perl_signal_remove() calls command_unbind() */
 347         signal = g_strconcat("command ", cmd, NULL);
 348         perl_signal_remove(signal, func);
 349         g_free(signal);
 350 }
 351
 352 static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
 353 {
 354         GSList *tmp, *next;
 355
 356         for (tmp = *list; tmp != NULL; tmp = next) {
 357                 PERL_SIGNAL_REC *rec = tmp->data;
 358
 359                 next = tmp->next;
 360                 if (script == NULL || rec->script == script) {
 361                         *list = g_slist_remove(*list, rec);
 362                         perl_signal_destroy(rec);
 363                 }
 364         }
 365
 366         if (*list != NULL)
 367                 return FALSE;
 368
 369         g_free(list);
 370         return TRUE;
 371 }
 372
 373 /* destroy all signals used by script */
 374 void perl_signal_remove_script(PERL_SCRIPT_REC *script)
 375 {
 376         g_hash_table_foreach_remove(signals, (GHRFunc) signal_destroy_hash,
 377                                     script);
 378 }
 379
 380 void perl_signals_start(void)
 381 {
 382         signals = g_hash_table_new(NULL, NULL);
 383 }
 384
 385 void perl_signals_stop(void)
 386 {
 387         g_hash_table_foreach(signals, (GHFunc) signal_destroy_hash, NULL);
 388         g_hash_table_destroy(signals);
 389         signals = NULL;
 390 }
 391
 392 static void register_signal_rec(PERL_SIGNAL_ARGS_REC *rec)
 393 {
 394         if (rec->signal[strlen(rec->signal)-1] == ' ') {
 395                 perl_signal_args_partial =
 396                         g_slist_append(perl_signal_args_partial, rec);
 397         } else {
 398                 int signal_id = signal_get_uniq_id(rec->signal);
 399                 g_hash_table_insert(perl_signal_args_hash,
 400                                     GINT_TO_POINTER(signal_id), rec);
 401         }
 402 }
 403
 404 void perl_signal_register(const char *signal, const char **args)
 405 {
 406         PERL_SIGNAL_ARGS_REC *rec;
 407         int i;
 408
 409         if (perl_signal_args_find(signal_get_uniq_id(signal)) != NULL)
 410                 return;
 411
 412         rec = g_new0(PERL_SIGNAL_ARGS_REC, 1);
 413         for (i = 0; i < 6 && args[i] != NULL; i++)
 414                 rec->args[i] = g_strdup(args[i]);
 415         rec->dynamic = TRUE;
 416         rec->signal = g_strdup(signal);
 417         register_signal_rec(rec);
 418 }
 419
 420 void perl_signals_init(void)
 421 {
 422         int n;
 423
 424         perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash,
 425                                                  (GCompareFunc) g_direct_equal);
 426         perl_signal_args_partial = NULL;
 427
 428         for (n = 0; perl_signal_args[n].signal != NULL; n++)
 429                 register_signal_rec(&perl_signal_args[n]);
 430 }
 431
 432 static void signal_args_free(PERL_SIGNAL_ARGS_REC *rec)
 433 {
 434         int i;
 435
 436         if (!rec->dynamic)
 437                 return;
 438
 439         for (i = 0; i < 6 && rec->args[i] != NULL; i++)
 440                 g_free(rec->args[i]);
 441         g_free(rec->signal);
 442         g_free(rec);
 443 }
 444
 445 static void signal_args_hash_free(void *key, PERL_SIGNAL_ARGS_REC *rec)
 446 {
 447         signal_args_free(rec);
 448 }
 449
 450 void perl_signals_deinit(void)
 451 {
 452         g_slist_foreach(perl_signal_args_partial,
 453                         (GFunc) signal_args_free, NULL);
 454         g_slist_free(perl_signal_args_partial);
 455
 456         g_hash_table_foreach(perl_signal_args_hash,
 457                              (GHFunc) signal_args_hash_free, NULL);
 458         g_hash_table_destroy(perl_signal_args_hash);
 459 }