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