src/perl.c

   1 /*
   2  * gaim
   3  *
   4  * Copyright (C) 1998-1999, Mark Spencer <markster@marko.net>
   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  * This was taken almost exactly from X-Chat. The power of the GPL.
  21  * Translated from X-Chat to Gaim by Eric Warmenhoven.
  22  * Originally by Erik Scrafford <eriks@chilisoft.com>.
  23  * X-Chat Copyright (C) 1998 Peter Zelezny.
  24  *
  25  */
  26
  27 #ifdef HAVE_CONFIG_H
  28 #include <config.h>
  29 #ifdef DEBUG
  30 #undef DEBUG
  31 #endif
  32 #endif
  33 #undef PACKAGE
  34
  35 #ifdef USE_PERL
  36
  37 #include <EXTERN.h>
  38 #ifndef _SEM_SEMUN_UNDEFINED
  39 #define HAS_UNION_SEMUN
  40 #endif
  41 #include <perl.h>
  42 #include <XSUB.h>
  43 #include <sys/mman.h>
  44 #include <sys/types.h>
  45 #include <sys/stat.h>
  46 #include <fcntl.h>
  47 #undef PACKAGE
  48 #include <stdio.h>
  49 #include <dirent.h>
  50 #include <string.h>
  51
  52
  53 /* perl module support */
  54 extern void xs_init _((void));
  55 extern void boot_DynaLoader _((CV * cv)); /* perl is so wacky */
  56
  57 #undef _
  58 #ifdef DEBUG
  59 #undef DEBUG
  60 #endif
  61 #include "gaim.h"
  62 #include "prpl.h"
  63
  64 struct perlscript {
  65         char *name;
  66         char *version;
  67         char *shutdowncallback; /* bleh */
  68 };
  69
  70 struct _perl_event_handlers {
  71         char *event_type;
  72         char *handler_name;
  73 };
  74
  75 struct _perl_timeout_handlers {
  76         char *handler_name;
  77         char *handler_args;
  78         gint iotag;
  79 };
  80
  81 static GList *perl_list = NULL; /* should probably extern this at some point */
  82 static GList *perl_timeout_handlers = NULL;
  83 static GList *perl_event_handlers = NULL;
  84 static PerlInterpreter *my_perl = NULL;
  85 static void perl_init();
  86
  87 /* dealing with gaim */
  88 XS(XS_GAIM_register); /* set up hooks for script */
  89 XS(XS_GAIM_get_info); /* version, last to attempt signon, protocol */
  90 XS(XS_GAIM_print); /* lemme figure this one out... */
  91 XS(XS_GAIM_write_to_conv); /* write into conversation window */
  92
  93 /* list stuff */
  94 XS(XS_GAIM_buddy_list); /* all buddies */
  95 XS(XS_GAIM_online_list); /* online buddies */
  96
  97 /* server stuff */
  98 XS(XS_GAIM_command); /* send command to server */
  99 XS(XS_GAIM_user_info); /* given name, return struct buddy members */
 100 XS(XS_GAIM_print_to_conv); /* send message to someone */
 101 XS(XS_GAIM_print_to_chat); /* send message to chat room */
 102 XS(XS_GAIM_serv_send_im); /* send message to someone (but do not display) */
 103
 104 /* handler commands */
 105 XS(XS_GAIM_add_event_handler); /* when servers talk */
 106 XS(XS_GAIM_add_timeout_handler); /* figure it out */
 107
 108 void xs_init()
 109 {
 110         char *file = __FILE__;
 111         newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 112 }
 113
 114 static char *escape_quotes(char *buf)
 115 {
 116         static char *tmp_buf = NULL;
 117         char *i, *j;
 118
 119         if (tmp_buf)
 120                 g_free(tmp_buf);
 121         tmp_buf = g_malloc(strlen(buf) * 2 + 1);
 122         for (i = buf, j = tmp_buf; *i; i++, j++) {
 123                 if (*i == '\'' || *i == '\\')
 124                         *j++ = '\\';
 125                 *j = *i;
 126         }
 127         *j = '\0';
 128
 129         return (tmp_buf);
 130 }
 131
 132 static SV *execute_perl(char *function, char *args)
 133 {
 134         static char *perl_cmd = NULL;
 135         SV *i;
 136
 137         if (perl_cmd)
 138                 g_free(perl_cmd);
 139         perl_cmd = g_malloc(strlen(function) + strlen(args) + 4);
 140         sprintf(perl_cmd, "&%s(%s)", function, args);
 141 #ifndef HAVE_PERL_EVAL_PV
 142         i = (perl_eval_pv(perl_cmd, TRUE));
 143 #else
 144         i = (Perl_eval_pv(perl_cmd, TRUE));
 145 #endif
 146         return i;
 147 }
 148
 149 int perl_load_file(char *script_name)
 150 {
 151         char *name = g_strdup_printf("'%s'", escape_quotes(script_name));
 152         SV *return_val;
 153         if (my_perl == NULL)
 154                 perl_init();
 155         return_val = execute_perl("load_file", name);
 156         g_free(name);
 157         return SvNV (return_val);
 158 }
 159
 160 static int is_pl_file(char *filename)
 161 {
 162         int len;
 163         if (!filename) return 0;
 164         if (!filename[0]) return 0;
 165         len = strlen(filename);
 166         len -= 3;
 167         if (len < 0) return 0;
 168         return (!strncmp(filename + len, ".pl", 3));
 169 }
 170
 171 void perl_autoload()
 172 {
 173         DIR *dir;
 174         struct dirent *ent;
 175         char *buf;
 176         char *path;
 177
 178         path = gaim_user_dir();
 179         dir = opendir(path);
 180         if (dir) {
 181                 while ((ent = readdir(dir))) {
 182                         if (strcmp(ent->d_name, ".") && strcmp(ent->d_name, "..")) {
 183                                 if (is_pl_file(ent->d_name)) {
 184                                         buf = g_malloc(strlen(path) + strlen(ent->d_name) + 2);
 185                                         sprintf(buf, "%s/%s", path, ent->d_name);
 186                                         perl_load_file(buf);
 187                                         g_free(buf);
 188                                 }
 189                         }
 190                 }
 191                 closedir(dir);
 192         }
 193         g_free(path);
 194 }
 195
 196 static void perl_init()
 197 {
 198         char *perl_args[] = {"", "-e", "0", "-w"};
 199         char load_file[] =
 200 "sub load_file()\n"
 201 "{\n"
 202 "       (my $file_name) = @_;\n"
 203 "       open FH, $file_name or return 2;\n"
 204 "       my $is = $/;\n"
 205 "       local($/) = undef;\n"
 206 "       $file = <FH>;\n"
 207 "       close FH;\n"
 208 "       $/ = $is;\n"
 209 "       $file = \"\\@ISA = qw(Exporter DynaLoader);\\n\" . $file;\n"
 210 "       eval $file;\n"
 211 "       eval $file if $@;\n"
 212 "       return 1 if $@;\n"
 213 "       return 0;\n"
 214 "}";
 215
 216         my_perl = perl_alloc();
 217         perl_construct(my_perl);
 218         perl_parse(my_perl, xs_init, 4, perl_args, NULL);
 219 #ifndef HAVE_PERL_EVAL_PV
 220         perl_eval_pv(load_file, TRUE);
 221 #else
 222         Perl_eval_pv(load_file, TRUE);
 223 #endif
 224
 225         newXS ("GAIM::register", XS_GAIM_register, "GAIM");
 226         newXS ("GAIM::get_info", XS_GAIM_get_info, "GAIM");
 227         newXS ("GAIM::print", XS_GAIM_print, "GAIM");
 228         newXS ("GAIM::write_to_conv", XS_GAIM_write_to_conv, "GAIM");
 229
 230         newXS ("GAIM::buddy_list", XS_GAIM_buddy_list, "GAIM");
 231         newXS ("GAIM::online_list", XS_GAIM_online_list, "GAIM");
 232
 233         newXS ("GAIM::command", XS_GAIM_command, "GAIM");
 234         newXS ("GAIM::user_info", XS_GAIM_user_info, "GAIM");
 235         newXS ("GAIM::print_to_conv", XS_GAIM_print_to_conv, "GAIM");
 236         newXS ("GAIM::print_to_chat", XS_GAIM_print_to_chat, "GAIM");
 237         newXS ("GAIM::serv_send_im", XS_GAIM_serv_send_im, "GAIM");
 238
 239         newXS ("GAIM::add_event_handler", XS_GAIM_add_event_handler, "GAIM");
 240         newXS ("GAIM::add_timeout_handler", XS_GAIM_add_timeout_handler, "GAIM");
 241 }
 242
 243 void perl_end()
 244 {
 245         struct perlscript *scp;
 246         struct _perl_timeout_handlers *thn;
 247         struct _perl_event_handlers *ehn;
 248
 249         while (perl_list) {
 250                 scp = perl_list->data;
 251                 perl_list = g_list_remove(perl_list, scp);
 252                 if (scp->shutdowncallback[0])
 253                         execute_perl(scp->shutdowncallback, "");
 254                 g_free(scp->name);
 255                 g_free(scp->version);
 256                 g_free(scp->shutdowncallback);
 257                 g_free(scp);
 258         }
 259
 260         while (perl_timeout_handlers) {
 261                 thn = perl_timeout_handlers->data;
 262                 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn);
 263                 g_source_remove(thn->iotag);
 264                 g_free(thn->handler_args);
 265                 g_free(thn->handler_name);
 266                 g_free(thn);
 267         }
 268
 269         while (perl_event_handlers) {
 270                 ehn = perl_event_handlers->data;
 271                 perl_event_handlers = g_list_remove(perl_event_handlers, ehn);
 272                 g_free(ehn->event_type);
 273                 g_free(ehn->handler_name);
 274                 g_free(ehn);
 275         }
 276
 277         if (my_perl != NULL) {
 278                 perl_destruct(my_perl);
 279                 perl_free(my_perl);
 280                 my_perl = NULL;
 281         }
 282 }
 283
 284 XS (XS_GAIM_register)
 285 {
 286         char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */
 287         unsigned int junk;
 288         struct perlscript *scp;
 289         dXSARGS;
 290         items = 0;
 291
 292         name = SvPV (ST (0), junk);
 293         ver = SvPV (ST (1), junk);
 294         callback = SvPV (ST (2), junk);
 295         unused = SvPV (ST (3), junk);
 296
 297         scp = g_new0(struct perlscript, 1);
 298         scp->name = g_strdup(name);
 299         scp->version = g_strdup(ver);
 300         scp->shutdowncallback = g_strdup(callback);
 301         perl_list = g_list_append(perl_list, scp);
 302
 303         XST_mPV (0, VERSION);
 304         XSRETURN (1);
 305 }
 306
 307 XS (XS_GAIM_get_info)
 308 {
 309         int i = 0;
 310         dXSARGS;
 311         items = 0;
 312
 313         switch(SvIV(ST(0))) {
 314         case 0:
 315                 XST_mPV(0, VERSION);
 316                 i = 1;
 317                 break;
 318         case 1:
 319                 {
 320                         GSList *c = connections;
 321                         struct gaim_connection *gc;
 322
 323                         while (c) {
 324                                 gc = (struct gaim_connection *)c->data;
 325                                 XST_mIV(i++, (guint)gc);
 326                                 c = c->next;
 327                         }
 328                 }
 329                 break;
 330         case 2:
 331                 {
 332                         struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 333                         if (g_slist_find(connections, gc))
 334                                 XST_mIV(i++, gc->protocol);
 335                         else
 336                                 XST_mIV(i++, -1);
 337                 }
 338                 break;
 339         case 3:
 340                 {
 341                         struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 342                         if (g_slist_find(connections, gc))
 343                                 XST_mPV(i++, gc->username);
 344                         else
 345                                 XST_mPV(i++, "");
 346                 }
 347                 break;
 348         case 4:
 349                 {
 350                         struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 351                         if (g_slist_find(connections, gc))
 352                                 XST_mIV(i++, g_slist_index(aim_users, gc->user));
 353                         else
 354                                 XST_mIV(i++, -1);
 355                 }
 356                 break;
 357         case 5:
 358                 {
 359                         GSList *a = aim_users;
 360                         while (a) {
 361                                 struct aim_user *u = a->data;
 362                                 XST_mPV(i++, u->username);
 363                                 a = a->next;
 364                         }
 365                 }
 366                 break;
 367         case 6:
 368                 {
 369                         GSList *a = aim_users;
 370                         while (a) {
 371                                 struct aim_user *u = a->data;
 372                                 XST_mIV(i++, u->protocol);
 373                                 a = a->next;
 374                         }
 375                 }
 376                 break;
 377         case 7:
 378                 {
 379                         struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 380                         if (g_slist_find(connections, gc))
 381                                 XST_mPV(i++, gc->prpl->name());
 382                         else
 383                                 XST_mPV(i++, "Unknown");
 384                 }
 385                 break;
 386         default:
 387                 XST_mPV(0, "Error2");
 388                 i = 1;
 389         }
 390
 391         XSRETURN(i);
 392 }
 393
 394 XS (XS_GAIM_print)
 395 {
 396         char *title;
 397         char *message;
 398         unsigned int junk;
 399         dXSARGS;
 400         items = 0;
 401
 402         title = SvPV(ST(0), junk);
 403         message = SvPV(ST(1), junk);
 404         do_error_dialog(message, title);
 405         XSRETURN(0);
 406 }
 407
 408 XS (XS_GAIM_buddy_list)
 409 {
 410         struct gaim_connection *gc;
 411         struct buddy *buddy;
 412         struct group *g;
 413         GSList *list = NULL;
 414         GSList *mem;
 415         int i = 0;
 416         dXSARGS;
 417         items = 0;
 418
 419         gc = (struct gaim_connection *)SvIV(ST(0));
 420         if (g_slist_find(connections, gc))
 421                 list = gc->groups;
 422
 423         while (list) {
 424                 g = (struct group *)list->data;
 425                 mem = g->members;
 426                 while (mem) {
 427                         buddy = (struct buddy *)mem->data;
 428                         XST_mPV(i++, buddy->name);
 429                         mem = mem->next;
 430                 }
 431                 list = g_slist_next(list);
 432         }
 433         XSRETURN(i);
 434 }
 435
 436 XS (XS_GAIM_online_list)
 437 {
 438         struct gaim_connection *gc;
 439         struct buddy *b;
 440         struct group *g;
 441         GSList *list = NULL;
 442         GSList *mem;
 443         int i = 0;
 444         dXSARGS;
 445         items = 0;
 446
 447         gc = (struct gaim_connection *)SvIV(ST(0));
 448         if (g_slist_find(connections, gc))
 449                 list = gc->groups;
 450
 451         while (list) {
 452                 g = (struct group *)list->data;
 453                 mem = g->members;
 454                 while (mem) {
 455                         b = (struct buddy *)mem->data;
 456                         if (b->present) XST_mPV(i++, b->name);
 457                         mem = mem->next;
 458                 }
 459                 list = g_slist_next(list);
 460         }
 461         XSRETURN(i);
 462 }
 463
 464 XS (XS_GAIM_command)
 465 {
 466         unsigned int junk;
 467         char *command = NULL;
 468         dXSARGS;
 469         items = 0;
 470
 471         command = SvPV(ST(0), junk);
 472         if (!command) XSRETURN(0);
 473         if        (!strncasecmp(command, "signon", 6)) {
 474                 int index = SvIV(ST(1));
 475                 if (g_slist_nth_data(aim_users, index))
 476                 serv_login(g_slist_nth_data(aim_users, index));
 477         } else if (!strncasecmp(command, "signoff", 7)) {
 478                 struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 479                 if (g_slist_find(connections, gc)) signoff(gc);
 480                 else signoff_all(NULL, NULL);
 481         } else if (!strncasecmp(command, "info", 4)) {
 482                 struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1));
 483                 if (g_slist_find(connections, gc))
 484                         serv_set_info(gc, SvPV(ST(2), junk));
 485         } else if (!strncasecmp(command, "away", 4)) {
 486                 char *message = SvPV(ST(1), junk);
 487                 static struct away_message a;
 488                 g_snprintf(a.message, sizeof(a.message), "%s", message);
 489                 do_away_message(NULL, &a);
 490         } else if (!strncasecmp(command, "back", 4)) {
 491                 do_im_back();
 492         } else if (!strncasecmp(command, "idle", 4)) {
 493                 GSList *c = connections;
 494                 struct gaim_connection *gc;
 495
 496                 while (c) {
 497                         gc = (struct gaim_connection *)c->data;
 498                         serv_set_idle(gc, SvIV(ST(1)));
 499                         c = c->next;
 500                 }
 501         } else if (!strncasecmp(command, "warn", 4)) {
 502                 GSList *c = connections;
 503                 struct gaim_connection *gc;
 504
 505                 while (c) {
 506                         gc = (struct gaim_connection *)c->data;
 507                         serv_warn(gc, SvPV(ST(1), junk), SvIV(ST(2)));
 508                         c = c->next;
 509                 }
 510         }
 511
 512         XSRETURN(0);
 513 }
 514
 515 XS (XS_GAIM_user_info)
 516 {
 517         struct gaim_connection *gc;
 518         unsigned int junk;
 519         struct buddy *buddy = NULL;
 520         dXSARGS;
 521         items = 0;
 522
 523         gc = (struct gaim_connection *)SvIV(ST(0));
 524         if (g_slist_find(connections, gc))
 525                 buddy = find_buddy(gc, SvPV(ST(1), junk));
 526
 527         if (!buddy)
 528                 XSRETURN(0);
 529         XST_mPV(0, buddy->name);
 530         XST_mPV(1, buddy->show);
 531         XST_mPV(2, buddy->present ? "Online" : "Offline");
 532         XST_mIV(3, buddy->evil);
 533         XST_mIV(4, buddy->signon);
 534         XST_mIV(5, buddy->idle);
 535         XST_mIV(6, buddy->uc);
 536         XST_mIV(7, buddy->caps);
 537         XSRETURN(8);
 538 }
 539
 540 XS (XS_GAIM_write_to_conv)
 541 {
 542         char *nick, *who, *what;
 543         struct conversation *c;
 544         int junk;
 545         int send, wflags;
 546         dXSARGS;
 547         items = 0;
 548
 549         nick = SvPV(ST(0), junk);
 550         send = SvIV(ST(1));
 551         what = SvPV(ST(2), junk);
 552         who = SvPV(ST(3), junk);
 553
 554         if (!*who) who=NULL;
 555
 556         switch (send) {
 557                 case 0: wflags=WFLAG_SEND; break;
 558                 case 1: wflags=WFLAG_RECV; break;
 559                 case 2: wflags=WFLAG_SYSTEM; break;
 560                 default: wflags=WFLAG_RECV;
 561         }
 562
 563         c = find_conversation(nick);
 564         if (!c)
 565                 c = new_conversation(nick);
 566
 567         write_to_conv(c, what, wflags, who, time(NULL), -1);
 568         XSRETURN(0);
 569 }
 570
 571 XS (XS_GAIM_serv_send_im)
 572 {
 573         struct gaim_connection *gc;
 574         char *nick, *what;
 575         int isauto;
 576         int junk;
 577         dXSARGS;
 578         items = 0;
 579
 580         gc = (struct gaim_connection *)SvIV(ST(0));
 581         nick = SvPV(ST(1), junk);
 582         what = SvPV(ST(2), junk);
 583         isauto = SvIV(ST(3));
 584
 585         if (!g_slist_find(connections, gc)) {
 586                 XSRETURN(0);
 587                 return;
 588         }
 589         serv_send_im(gc, nick, what, -1, isauto);
 590         XSRETURN(0);
 591 }
 592
 593 XS (XS_GAIM_print_to_conv)
 594 {
 595         struct gaim_connection *gc;
 596         char *nick, *what;
 597         int isauto;
 598         struct conversation *c;
 599         unsigned int junk;
 600         dXSARGS;
 601         items = 0;
 602
 603         gc = (struct gaim_connection *)SvIV(ST(0));
 604         nick = SvPV(ST(1), junk);
 605         what = SvPV(ST(2), junk);
 606         isauto = SvIV(ST(3));
 607         if (!g_slist_find(connections, gc)) {
 608                 XSRETURN(0);
 609                 return;
 610         }
 611         c = find_conversation(nick);
 612         if (!c)
 613                 c = new_conversation(nick);
 614         set_convo_gc(c, gc);
 615         write_to_conv(c, what, WFLAG_SEND | (isauto ? WFLAG_AUTO : 0), NULL, time(NULL), -1);
 616         serv_send_im(c->gc, nick, what, -1, isauto ? IM_FLAG_AWAY : 0);
 617         XSRETURN(0);
 618 }
 619
 620 XS (XS_GAIM_print_to_chat)
 621 {
 622         struct gaim_connection *gc;
 623         int id;
 624         char *what;
 625         struct conversation *b = NULL;
 626         GSList *bcs;
 627         unsigned int junk;
 628         dXSARGS;
 629         items = 0;
 630
 631         gc = (struct gaim_connection *)SvIV(ST(0));
 632         id = SvIV(ST(1));
 633         what = SvPV(ST(2), junk);
 634
 635         if (!g_slist_find(connections, gc)) {
 636                 XSRETURN(0);
 637                 return;
 638         }
 639         bcs = gc->buddy_chats;
 640         while (bcs) {
 641                 b = (struct conversation *)bcs->data;
 642                 if (b->id == id)
 643                         break;
 644                 bcs = bcs->next;
 645                 b = NULL;
 646         }
 647         if (b)
 648                 serv_chat_send(gc, id, what);
 649         XSRETURN(0);
 650 }
 651
 652 int perl_event(enum gaim_event event, void *arg1, void *arg2, void *arg3, void *arg4)
 653 {
 654         char *buf = NULL;
 655         GList *handler;
 656         struct _perl_event_handlers *data;
 657         SV *handler_return;
 658
 659         switch (event) {
 660         case event_signon:
 661         case event_signoff:
 662                 buf = g_strdup_printf("'%lu'", (unsigned long)arg1);
 663                 break;
 664         case event_away:
 665                 buf = g_strdup_printf("'%lu','%s'", (unsigned long)arg1,
 666                                 ((struct gaim_connection *)arg1)->away ?
 667                                         escape_quotes(((struct gaim_connection *)arg1)->away) : "");
 668                 break;
 669         case event_im_recv:
 670                 {
 671                 char *tmp = *(char **)arg2 ? g_strdup(escape_quotes(*(char **)arg2)) : g_malloc0(1);
 672                 buf = g_strdup_printf("'%lu','%s','%s'", (unsigned long)arg1, tmp,
 673                            *(char **)arg3 ? escape_quotes(*(char **)arg3) : "");
 674                 g_free(tmp);
 675                 }
 676                 break;
 677         case event_im_send:
 678                 {
 679                 char *tmp = arg2 ? g_strdup(escape_quotes(arg2)) : g_malloc0(1);
 680                 buf = g_strdup_printf("'%lu','%s','%s'", (unsigned long)arg1, tmp,
 681                            *(char **)arg3 ? escape_quotes(*(char **)arg3) : "");
 682                 g_free(tmp);
 683                 }
 684                 break;
 685         case event_buddy_signon:
 686         case event_buddy_signoff:
 687         case event_set_info:
 688         case event_buddy_away:
 689         case event_buddy_back:
 690         case event_buddy_idle:
 691         case event_buddy_unidle:
 692                 buf = g_strdup_printf("'%lu','%s'", (unsigned long)arg1, escape_quotes(arg2));
 693                 break;
 694         case event_chat_invited:
 695                 {
 696                 char *tmp2, *tmp3, *tmp4;
 697                 tmp2 = g_strdup(escape_quotes(arg2));
 698                 tmp3 = g_strdup(escape_quotes(arg3));
 699                 tmp4 = arg4 ? g_strdup(escape_quotes(arg4)) : g_malloc0(1);
 700                 buf = g_strdup_printf("'%lu','%s','%s','%s'", (unsigned long)arg1, tmp2, tmp3, tmp4);
 701                 g_free(tmp2);
 702                 g_free(tmp3);
 703                 g_free(tmp4);
 704                 }
 705                 break;
 706         case event_chat_join:
 707         case event_chat_buddy_join:
 708         case event_chat_buddy_leave:
 709                 buf = g_strdup_printf("'%lu','%d','%s'", (unsigned long)arg1, (int)arg2,
 710                                 escape_quotes(arg3));
 711                 break;
 712         case event_chat_leave:
 713                 buf = g_strdup_printf("'%lu','%d'", (unsigned long)arg1, (int)arg2);
 714                 break;
 715         case event_chat_recv:
 716                 {
 717                 char *t3, *t4;
 718                 t3 = g_strdup(escape_quotes(arg3));
 719                 t4 = arg4 ? g_strdup(escape_quotes(arg4)) : g_malloc0(1);
 720                 buf = g_strdup_printf("'%lu','%d','%s','%s'", (unsigned long)arg1, (int)arg2, t3, t4);
 721                 g_free(t3);
 722                 g_free(t4);
 723                 }
 724                 break;
 725         case event_chat_send_invite:
 726                 {
 727                 char *t3, *t4;
 728                 t3 = g_strdup(escape_quotes(arg3));
 729                 t4 = *(char **)arg4 ? g_strdup(escape_quotes(*(char **)arg4)) : g_malloc0(1);
 730                 buf = g_strdup_printf("'%lu','%d','%s','%s'", (unsigned long)arg1, (int)arg2, t3, t4);
 731                 g_free(t3);
 732                 g_free(t4);
 733                 }
 734                 break;
 735         case event_chat_send:
 736                 buf = g_strdup_printf("'%lu','%d','%s'", (unsigned long)arg1, (int)arg2,
 737                                 *(char **)arg3 ? escape_quotes(*(char **)arg3) : "");
 738                 break;
 739         case event_warned:
 740                 buf = g_strdup_printf("'%lu','%s','%d'", (unsigned long)arg1,
 741                                 arg2 ? escape_quotes(arg2) : "", (int)arg3);
 742                 break;
 743         case event_quit:
 744                 buf = g_malloc0(1);
 745                 break;
 746         case event_new_conversation:
 747                 buf = g_strdup_printf("'%s'", escape_quotes(arg1));
 748                 break;
 749         case event_im_displayed_sent:
 750                 {
 751                 char *tmp2, *tmp3;
 752                 tmp2 = g_strdup(escape_quotes(arg2));
 753                 tmp3 = *(char **)arg3 ? g_strdup(escape_quotes(*(char **)arg3)) : g_malloc0(1);
 754                 buf = g_strdup_printf("'%lu','%s','%s'", (unsigned long)arg1, tmp2, tmp3);
 755                 g_free(tmp2);
 756                 g_free(tmp3);
 757                 }
 758                 break;
 759         case event_im_displayed_rcvd:
 760                 {
 761                 char *tmp2, *tmp3;
 762                 tmp2 = g_strdup(escape_quotes(arg2));
 763                 tmp3 = arg3 ? g_strdup(escape_quotes(arg3)) : g_malloc0(1);
 764                 buf = g_strdup_printf("'%lu','%s','%s'", (unsigned long)arg1, tmp2, tmp3);
 765                 g_free(tmp2);
 766                 g_free(tmp3);
 767                 }
 768                 break;
 769         default:
 770                 return 0;
 771         }
 772
 773         for (handler = perl_event_handlers; handler != NULL; handler = handler->next) {
 774                 data = handler->data;
 775                 if (!strcmp(event_name(event), data->event_type)) {
 776                         handler_return = execute_perl(data->handler_name, buf);
 777                         if (SvIV(handler_return)) {
 778                                 if (buf)
 779                                         g_free(buf);
 780                                 return SvIV(handler_return);
 781                         }
 782                 }
 783         }
 784
 785         if (buf)
 786                 g_free(buf);
 787
 788         return 0;
 789 }
 790
 791 XS (XS_GAIM_add_event_handler)
 792 {
 793         unsigned int junk;
 794         struct _perl_event_handlers *handler;
 795         dXSARGS;
 796         items = 0;
 797
 798         handler = g_new0(struct _perl_event_handlers, 1);
 799         handler->event_type = g_strdup(SvPV(ST(0), junk));
 800         handler->handler_name = g_strdup(SvPV(ST(1), junk));
 801         perl_event_handlers = g_list_append(perl_event_handlers, handler);
 802         debug_printf("registered perl event handler for %s\n", handler->event_type);
 803         XSRETURN_EMPTY;
 804 }
 805
 806 static int perl_timeout(gpointer data)
 807 {
 808         struct _perl_timeout_handlers *handler = data;
 809         execute_perl(handler->handler_name, escape_quotes(handler->handler_args));
 810         perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler);
 811         g_free(handler->handler_args);
 812         g_free(handler->handler_name);
 813         g_free(handler);
 814
 815         return 0; /* returning zero removes the timeout handler */
 816 }
 817
 818 XS (XS_GAIM_add_timeout_handler)
 819 {
 820         unsigned int junk;
 821         long timeout;
 822         struct _perl_timeout_handlers *handler;
 823         dXSARGS;
 824         items = 0;
 825
 826         handler = g_new0(struct _perl_timeout_handlers, 1);
 827         timeout = 1000 * SvIV(ST(0));
 828         debug_printf("Adding timeout for %d seconds.\n", timeout/1000);
 829         handler->handler_name = g_strdup(SvPV(ST(1), junk));
 830         handler->handler_args = g_strdup(SvPV(ST(2), junk));
 831         perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler);
 832         handler->iotag = g_timeout_add(timeout, perl_timeout, handler);
 833         XSRETURN_EMPTY;
 834 }
 835
 836 extern void unload_perl_scripts()
 837 {
 838         perl_end();
 839         perl_init();
 840 }
 841
 842 extern void list_perl_scripts()
 843 {
 844         GList *s = perl_list;
 845         struct perlscript *p;
 846         char buf[BUF_LONG * 4];
 847         int at = 0;
 848
 849         at += g_snprintf(buf + at, sizeof(buf) - at, "Loaded scripts:\n");
 850         while (s) {
 851                 p = (struct perlscript *)s->data;
 852                 at += g_snprintf(buf + at, sizeof(buf) - at, "%s\n", p->name);
 853                 s = s->next;
 854         }
 855
 856         do_error_dialog(buf, _("Perl Scripts"));
 857 }
 858
 859 #endif /* USE_PERL */