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

   1 /*
   2  perl-common.c : irssi
   3
   4     Copyright (C) 2000 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 "core.h"
  26 #include "misc.h"
  27 #include "settings.h"
  28
  29 #include "commands.h"
  30 #include "ignore.h"
  31 #include "log.h"
  32 #include "rawlog.h"
  33 #include "servers-reconnect.h"
  34
  35 #include "window-item-def.h"
  36 #include "chat-protocols.h"
  37 #include "chatnets.h"
  38 #include "servers.h"
  39 #include "channels.h"
  40 #include "queries.h"
  41 #include "nicklist.h"
  42
  43 #include "perl-common.h"
  44
  45 typedef struct {
  46         char *stash;
  47         PERL_OBJECT_FUNC fill_func;
  48 } PERL_OBJECT_REC;
  49
  50 #ifndef HAVE_PL_PERL
  51 STRLEN PL_na;
  52 #endif
  53
  54 static GHashTable *iobject_stashes, *plain_stashes;
  55 static GSList *use_protocols;
  56
  57 /* returns the package who called us */
  58 const char *perl_get_package(void)
  59 {
  60         return SvPV(perl_eval_pv("caller", TRUE), PL_na);
  61 }
  62
  63 /* Parses the package part from function name */
  64 char *perl_function_get_package(const char *function)
  65 {
  66         const char *p;
  67         int pos;
  68
  69         pos = 0;
  70         for (p = function; *p != '\0'; p++) {
  71                 if (*p == ':' && p[1] == ':') {
  72                         if (++pos == 3)
  73                                 return g_strndup(function, (int) (p-function));
  74                 }
  75         }
  76
  77         return NULL;
  78 }
  79
  80 SV *perl_func_sv_inc(SV *func, const char *package)
  81 {
  82         char *name;
  83
  84         if (SvPOK(func)) {
  85                 /* prefix with package name */
  86                 name = g_strdup_printf("%s::%s", package,
  87                                        (char *) SvPV(func, PL_na));
  88                 func = new_pv(name);
  89                 g_free(name);
  90         } else {
  91                 SvREFCNT_inc(func);
  92         }
  93
  94         return func;
  95 }
  96
  97 SV *irssi_bless_iobject(int type, int chat_type, void *object)
  98 {
  99         PERL_OBJECT_REC *rec;
 100         HV *stash, *hv;
 101
 102         g_return_val_if_fail((type & ~0xffff) == 0, NULL);
 103         g_return_val_if_fail((chat_type & ~0xffff) == 0, NULL);
 104
 105         rec = g_hash_table_lookup(iobject_stashes,
 106                                   GINT_TO_POINTER(type | (chat_type << 16)));
 107         if (rec == NULL) {
 108                 /* unknown iobject */
 109                 return newSViv(GPOINTER_TO_INT(object));
 110         }
 111
 112         stash = gv_stashpv(rec->stash, 1);
 113
 114         hv = newHV();
 115         hv_store(hv, "_irssi", 6, newSViv(GPOINTER_TO_INT(object)), 0);
 116         rec->fill_func(hv, object);
 117         return sv_bless(newRV_noinc((SV*)hv), stash);
 118 }
 119
 120 SV *irssi_bless_plain(const char *stash, void *object)
 121 {
 122         PERL_OBJECT_FUNC fill_func;
 123         HV *hv;
 124
 125         fill_func = g_hash_table_lookup(plain_stashes, stash);
 126
 127         hv = newHV();
 128         hv_store(hv, "_irssi", 6, newSViv(GPOINTER_TO_INT(object)), 0);
 129         if (fill_func != NULL)
 130                 fill_func(hv, object);
 131         return sv_bless(newRV_noinc((SV*)hv), gv_stashpv((char *)stash, 1));
 132 }
 133
 134 int irssi_is_ref_object(SV *o)
 135 {
 136         SV **sv;
 137         HV *hv;
 138
 139         hv = hvref(o);
 140         if (hv != NULL) {
 141                 sv = hv_fetch(hv, "_irssi", 6, 0);
 142                 if (sv != NULL)
 143                         return TRUE;
 144         }
 145
 146         return FALSE;
 147 }
 148
 149 void *irssi_ref_object(SV *o)
 150 {
 151         SV **sv;
 152         HV *hv;
 153
 154         hv = hvref(o);
 155         if (hv == NULL)
 156                 return NULL;
 157
 158         sv = hv_fetch(hv, "_irssi", 6, 0);
 159         if (sv == NULL)
 160                 croak("variable is damaged");
 161         return GINT_TO_POINTER(SvIV(*sv));
 162 }
 163
 164 void irssi_add_object(int type, int chat_type, const char *stash,
 165                       PERL_OBJECT_FUNC func)
 166 {
 167         PERL_OBJECT_REC *rec;
 168         void *hash;
 169
 170         g_return_if_fail((type & ~0xffff) == 0);
 171         g_return_if_fail((chat_type & ~0xffff) == 0);
 172
 173         hash = GINT_TO_POINTER(type | (chat_type << 16));
 174         rec = g_hash_table_lookup(iobject_stashes, hash);
 175         if (rec == NULL) {
 176                 rec = g_new(PERL_OBJECT_REC, 1);
 177                 rec->stash = g_strdup(stash);
 178                 g_hash_table_insert(iobject_stashes, hash, rec);
 179         }
 180         rec->fill_func = func;
 181 }
 182
 183 void irssi_add_plain(const char *stash, PERL_OBJECT_FUNC func)
 184 {
 185         if (g_hash_table_lookup(plain_stashes, stash) == NULL)
 186                 g_hash_table_insert(plain_stashes, g_strdup(stash), func);
 187 }
 188
 189 void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects)
 190 {
 191         while (objects->name != NULL) {
 192                 irssi_add_plain(objects->name, objects->fill_func);
 193                 objects++;
 194         }
 195 }
 196
 197 char *perl_get_use_list(void)
 198 {
 199         GString *str;
 200         GSList *tmp;
 201         char *ret;
 202         const char *use_lib;
 203
 204         str = g_string_new(NULL);
 205
 206         use_lib = settings_get_str("perl_use_lib");
 207         g_string_sprintf(str, "use lib qw(%s/scripts "SCRIPTDIR" %s);",
 208                          get_irssi_dir(), use_lib);
 209
 210         g_string_append(str, "use Irssi;");
 211         if (irssi_gui != IRSSI_GUI_NONE)
 212                 g_string_append(str, "use Irssi::UI;");
 213
 214         for (tmp = use_protocols; tmp != NULL; tmp = tmp->next)
 215                 g_string_sprintfa(str, "use Irssi::%s;", (char *) tmp->data);
 216
 217         ret = str->str;
 218         g_string_free(str, FALSE);
 219         return ret;
 220 }
 221
 222 void irssi_callXS(void (*subaddr)(CV* cv), CV *cv, SV **mark)
 223 {
 224         dSP;
 225
 226         PUSHMARK(mark);
 227         (*subaddr)(cv);
 228
 229         PUTBACK;
 230 }
 231
 232 void perl_chatnet_fill_hash(HV *hv, CHATNET_REC *chatnet)
 233 {
 234         char *type, *chat_type;
 235
 236         g_return_if_fail(hv != NULL);
 237         g_return_if_fail(chatnet != NULL);
 238
 239         type = "CHATNET";
 240         chat_type = (char *) chat_protocol_find_id(chatnet->chat_type)->name;
 241
 242         hv_store(hv, "type", 4, new_pv(type), 0);
 243         hv_store(hv, "chat_type", 9, new_pv(chat_type), 0);
 244
 245         hv_store(hv, "name", 4, new_pv(chatnet->name), 0);
 246
 247         hv_store(hv, "nick", 4, new_pv(chatnet->nick), 0);
 248         hv_store(hv, "username", 8, new_pv(chatnet->username), 0);
 249         hv_store(hv, "realname", 8, new_pv(chatnet->realname), 0);
 250
 251         hv_store(hv, "own_host", 8, new_pv(chatnet->own_host), 0);
 252         hv_store(hv, "autosendcmd", 11, new_pv(chatnet->autosendcmd), 0);
 253 }
 254
 255 void perl_connect_fill_hash(HV *hv, SERVER_CONNECT_REC *conn)
 256 {
 257         char *type, *chat_type;
 258
 259         g_return_if_fail(hv != NULL);
 260         g_return_if_fail(conn != NULL);
 261
 262         type = "SERVER CONNECT";
 263         chat_type = (char *) chat_protocol_find_id(conn->chat_type)->name;
 264
 265         hv_store(hv, "type", 4, new_pv(type), 0);
 266         hv_store(hv, "chat_type", 9, new_pv(chat_type), 0);
 267
 268         hv_store(hv, "address", 7, new_pv(conn->address), 0);
 269         hv_store(hv, "port", 4, newSViv(conn->port), 0);
 270         hv_store(hv, "chatnet", 7, new_pv(conn->chatnet), 0);
 271
 272         hv_store(hv, "password", 8, new_pv(conn->password), 0);
 273         hv_store(hv, "wanted_nick", 11, new_pv(conn->nick), 0);
 274         hv_store(hv, "username", 8, new_pv(conn->username), 0);
 275         hv_store(hv, "realname", 8, new_pv(conn->realname), 0);
 276 }
 277
 278 void perl_server_fill_hash(HV *hv, SERVER_REC *server)
 279 {
 280         char *type;
 281         HV *stash;
 282
 283         g_return_if_fail(hv != NULL);
 284         g_return_if_fail(server != NULL);
 285
 286         perl_connect_fill_hash(hv, server->connrec);
 287
 288         type = "SERVER";
 289         hv_store(hv, "type", 4, new_pv(type), 0);
 290
 291         hv_store(hv, "connect_time", 12, newSViv(server->connect_time), 0);
 292         hv_store(hv, "real_connect_time", 17, newSViv(server->real_connect_time), 0);
 293
 294         hv_store(hv, "tag", 3, new_pv(server->tag), 0);
 295         hv_store(hv, "nick", 4, new_pv(server->nick), 0);
 296
 297         hv_store(hv, "connected", 9, newSViv(server->connected), 0);
 298         hv_store(hv, "connection_lost", 15, newSViv(server->connection_lost), 0);
 299
 300         stash = gv_stashpv("Irssi::Rawlog", 0);
 301         hv_store(hv, "rawlog", 6, sv_bless(newRV_noinc(newSViv(GPOINTER_TO_INT(server->rawlog))), stash), 0);
 302
 303         hv_store(hv, "version", 7, new_pv(server->version), 0);
 304         hv_store(hv, "away_reason", 11, new_pv(server->away_reason), 0);
 305         hv_store(hv, "last_invite", 11, new_pv(server->last_invite), 0);
 306         hv_store(hv, "server_operator", 15, newSViv(server->server_operator), 0);
 307         hv_store(hv, "usermode_away", 13, newSViv(server->usermode_away), 0);
 308         hv_store(hv, "banned", 6, newSViv(server->banned), 0);
 309
 310         hv_store(hv, "lag", 3, newSViv(server->lag), 0);
 311 }
 312
 313 void perl_window_item_fill_hash(HV *hv, WI_ITEM_REC *item)
 314 {
 315         char *type, *chat_type;
 316
 317         g_return_if_fail(hv != NULL);
 318         g_return_if_fail(item != NULL);
 319
 320         type = (char *) module_find_id_str("WINDOW ITEM TYPE", item->type);
 321         chat_type = (char *) chat_protocol_find_id(item->chat_type)->name;
 322
 323         hv_store(hv, "type", 4, new_pv(type), 0);
 324         hv_store(hv, "chat_type", 9, new_pv(chat_type), 0);
 325
 326         if (item->server != NULL) {
 327                 hv_store(hv, "server", 6, iobject_bless(item->server), 0);
 328         }
 329         hv_store(hv, "name", 4, new_pv(item->name), 0);
 330
 331         hv_store(hv, "createtime", 10, newSViv(item->createtime), 0);
 332         hv_store(hv, "data_level", 10, newSViv(item->data_level), 0);
 333         hv_store(hv, "hilight_color", 13, new_pv(item->hilight_color), 0);
 334 }
 335
 336 void perl_channel_fill_hash(HV *hv, CHANNEL_REC *channel)
 337 {
 338         g_return_if_fail(hv != NULL);
 339         g_return_if_fail(channel != NULL);
 340
 341         perl_window_item_fill_hash(hv, (WI_ITEM_REC *) channel);
 342
 343         if (channel->ownnick != NULL)
 344                 hv_store(hv, "ownnick", 7, iobject_bless(channel->ownnick), 0);
 345
 346         hv_store(hv, "topic", 5, new_pv(channel->topic), 0);
 347         hv_store(hv, "topic_by", 8, new_pv(channel->topic_by), 0);
 348         hv_store(hv, "topic_time", 10, newSViv(channel->topic_time), 0);
 349
 350         hv_store(hv, "no_modes", 8, newSViv(channel->no_modes), 0);
 351         hv_store(hv, "mode", 4, new_pv(channel->mode), 0);
 352         hv_store(hv, "limit", 5, newSViv(channel->limit), 0);
 353         hv_store(hv, "key", 3, new_pv(channel->key), 0);
 354
 355         hv_store(hv, "chanop", 6, newSViv(channel->chanop), 0);
 356         hv_store(hv, "names_got", 9, newSViv(channel->names_got), 0);
 357         hv_store(hv, "wholist", 7, newSViv(channel->wholist), 0);
 358         hv_store(hv, "synced", 6, newSViv(channel->synced), 0);
 359
 360         hv_store(hv, "joined", 6, newSViv(channel->joined), 0);
 361         hv_store(hv, "left", 4, newSViv(channel->left), 0);
 362         hv_store(hv, "kicked", 6, newSViv(channel->kicked), 0);
 363 }
 364
 365 void perl_query_fill_hash(HV *hv, QUERY_REC *query)
 366 {
 367         g_return_if_fail(hv != NULL);
 368         g_return_if_fail(query != NULL);
 369
 370         perl_window_item_fill_hash(hv, (WI_ITEM_REC *) query);
 371
 372         hv_store(hv, "last_unread_msg", 15, newSViv(query->last_unread_msg), 0);
 373         hv_store(hv, "address", 7, new_pv(query->address), 0);
 374         hv_store(hv, "server_tag", 10, new_pv(query->server_tag), 0);
 375         hv_store(hv, "unwanted", 8, newSViv(query->unwanted), 0);
 376 }
 377
 378 void perl_nick_fill_hash(HV *hv, NICK_REC *nick)
 379 {
 380         char *type, *chat_type;
 381
 382         g_return_if_fail(hv != NULL);
 383         g_return_if_fail(nick != NULL);
 384
 385         type = "NICK";
 386         chat_type = (char *) chat_protocol_find_id(nick->chat_type)->name;
 387
 388         hv_store(hv, "type", 4, new_pv(type), 0);
 389         hv_store(hv, "chat_type", 9, new_pv(chat_type), 0);
 390
 391         hv_store(hv, "nick", 4, new_pv(nick->nick), 0);
 392         hv_store(hv, "host", 4, new_pv(nick->host), 0);
 393         hv_store(hv, "realname", 8, new_pv(nick->realname), 0);
 394         hv_store(hv, "hops", 4, newSViv(nick->hops), 0);
 395
 396         hv_store(hv, "gone", 4, newSViv(nick->gone), 0);
 397         hv_store(hv, "serverop", 8, newSViv(nick->serverop), 0);
 398
 399         hv_store(hv, "op", 2, newSViv(nick->op), 0);
 400         hv_store(hv, "halfop", 6, newSViv(nick->halfop), 0);
 401         hv_store(hv, "voice", 5, newSViv(nick->voice), 0);
 402
 403         hv_store(hv, "last_check", 10, newSViv(nick->last_check), 0);
 404         hv_store(hv, "send_massjoin", 13, newSViv(nick->send_massjoin), 0);
 405 }
 406
 407 static void perl_command_fill_hash(HV *hv, COMMAND_REC *cmd)
 408 {
 409         hv_store(hv, "category", 8, new_pv(cmd->category), 0);
 410         hv_store(hv, "cmd", 3, new_pv(cmd->cmd), 0);
 411 }
 412
 413 static void perl_ignore_fill_hash(HV *hv, IGNORE_REC *ignore)
 414 {
 415         AV *av;
 416         char **tmp;
 417
 418         hv_store(hv, "mask", 4, new_pv(ignore->mask), 0);
 419         hv_store(hv, "servertag", 9, new_pv(ignore->servertag), 0);
 420         av = newAV();
 421         for (tmp = ignore->channels; *tmp != NULL; tmp++) {
 422                 av_push(av, new_pv(*tmp));
 423         }
 424         hv_store(hv, "channels", 8, newRV_noinc((SV*)av), 0);
 425         hv_store(hv, "pattern", 7, new_pv(ignore->pattern), 0);
 426
 427         hv_store(hv, "level", 5, newSViv(ignore->level), 0);
 428
 429         hv_store(hv, "exception", 9, newSViv(ignore->exception), 0);
 430         hv_store(hv, "regexp", 6, newSViv(ignore->regexp), 0);
 431         hv_store(hv, "fullword", 8, newSViv(ignore->fullword), 0);
 432 }
 433
 434 static void perl_log_fill_hash(HV *hv, LOG_REC *log)
 435 {
 436         AV *av;
 437         GSList *tmp;
 438
 439         hv_store(hv, "fname", 5, new_pv(log->fname), 0);
 440         hv_store(hv, "real_fname", 10, new_pv(log->real_fname), 0);
 441         hv_store(hv, "opened", 6, newSViv(log->opened), 0);
 442         hv_store(hv, "level", 5, newSViv(log->level), 0);
 443         hv_store(hv, "last", 4, newSViv(log->last), 0);
 444         hv_store(hv, "autoopen", 8, newSViv(log->autoopen), 0);
 445         hv_store(hv, "failed", 6, newSViv(log->failed), 0);
 446         hv_store(hv, "temp", 4, newSViv(log->temp), 0);
 447
 448         av = newAV();
 449         for (tmp = log->items; tmp != NULL; tmp = tmp->next) {
 450                 av_push(av, plain_bless(tmp->data, "Irssi::Logitem"));
 451         }
 452         hv_store(hv, "items", 5, newRV_noinc((SV*)av), 0);
 453 }
 454
 455 static void perl_log_item_fill_hash(HV *hv, LOG_ITEM_REC *item)
 456 {
 457         hv_store(hv, "type", 4, newSViv(item->type), 0);
 458         hv_store(hv, "name", 4, new_pv(item->name), 0);
 459         hv_store(hv, "servertag", 9, new_pv(item->servertag), 0);
 460 }
 461
 462 static void perl_rawlog_fill_hash(HV *hv, RAWLOG_REC *rawlog)
 463 {
 464         hv_store(hv, "logging", 7, newSViv(rawlog->logging), 0);
 465         hv_store(hv, "nlines", 6, newSViv(rawlog->nlines), 0);
 466 }
 467
 468 static void perl_reconnect_fill_hash(HV *hv, RECONNECT_REC *reconnect)
 469 {
 470         char *type;
 471
 472         perl_connect_fill_hash(hv, reconnect->conn);
 473
 474         type = "RECONNECT";
 475         hv_store(hv, "type", 4, new_pv(type), 0);
 476
 477         hv_store(hv, "tag", 3, newSViv(reconnect->tag), 0);
 478         hv_store(hv, "next_connect", 12, newSViv(reconnect->next_connect), 0);
 479 }
 480
 481 void perl_command(const char *cmd, SERVER_REC *server, WI_ITEM_REC *item)
 482 {
 483         const char *cmdchars;
 484         char *sendcmd = (char *) cmd;
 485
 486         if (*cmd == '\0')
 487                 return;
 488
 489         cmdchars = settings_get_str("cmdchars");
 490         if (strchr(cmdchars, *cmd) == NULL) {
 491                 /* no command char - let's put it there.. */
 492                 sendcmd = g_strdup_printf("%c%s", *cmdchars, cmd);
 493         }
 494
 495         signal_emit("send command", 3, sendcmd, server, item);
 496         if (sendcmd != cmd) g_free(sendcmd);
 497 }
 498
 499 static void perl_register_protocol(CHAT_PROTOCOL_REC *rec)
 500 {
 501         static char *items[] = {
 502                 "Chatnet",
 503                 "Server", "ServerConnect", "ServerSetup",
 504                 "Channel", "Query",
 505                 "Nick"
 506         };
 507         static char *find_use_code =
 508                 "my $pkg = Irssi::%s; $pkg =~ s/::/\\//;\n"
 509                 "foreach my $i (@INC) {\n"
 510                 "  return 1 if (-f \"$i/$pkg.pm\");\n"
 511                 "}\n"
 512                 "return 0;\n";
 513
 514         char *name, stash[100], code[100], *pcode;
 515         int type, chat_type, n;
 516         SV *sv;
 517
 518         chat_type = chat_protocol_lookup(rec->name);
 519         g_return_if_fail(chat_type >= 0);
 520
 521         name = g_strdup(rec->name);
 522         g_strdown(name+1);
 523
 524         /* window items: channel, query */
 525         type = module_get_uniq_id_str("WINDOW ITEM TYPE", "CHANNEL");
 526         g_snprintf(stash, sizeof(stash), "Irssi::%s::Channel", name);
 527         irssi_add_object(type, chat_type, stash,
 528                          (PERL_OBJECT_FUNC) perl_channel_fill_hash);
 529
 530         type = module_get_uniq_id_str("WINDOW ITEM TYPE", "QUERY");
 531         g_snprintf(stash, sizeof(stash), "Irssi::%s::Query", name);
 532         irssi_add_object(type, chat_type, stash,
 533                          (PERL_OBJECT_FUNC) perl_query_fill_hash);
 534
 535         /* channel nicks */
 536         type = module_get_uniq_id("NICK", 0);
 537         g_snprintf(stash, sizeof(stash), "Irssi::%s::Nick", name);
 538         irssi_add_object(type, chat_type, stash,
 539                          (PERL_OBJECT_FUNC) perl_nick_fill_hash);
 540
 541         /* chatnets */
 542         type = module_get_uniq_id("CHATNET", 0);
 543         g_snprintf(stash, sizeof(stash), "Irssi::%s::Chatnet", name);
 544         irssi_add_object(type, chat_type, stash,
 545                          (PERL_OBJECT_FUNC) perl_chatnet_fill_hash);
 546
 547         /* server specific */
 548         type = module_get_uniq_id("SERVER", 0);
 549         g_snprintf(stash, sizeof(stash), "Irssi::%s::Server", name);
 550         irssi_add_object(type, chat_type, stash,
 551                          (PERL_OBJECT_FUNC) perl_server_fill_hash);
 552
 553         type = module_get_uniq_id("SERVER CONNECT", 0);
 554         g_snprintf(stash, sizeof(stash), "Irssi::%s::Connect", name);
 555         irssi_add_object(type, chat_type, stash,
 556                          (PERL_OBJECT_FUNC) perl_connect_fill_hash);
 557
 558         /* register ISAs */
 559         for (n = 0; n < sizeof(items)/sizeof(items[0]); n++) {
 560                 g_snprintf(code, sizeof(code),
 561                            "@Irssi::%s::%s::ISA = qw(Irssi::%s);",
 562                            name, items[n], items[n]);
 563                 perl_eval_pv(code, TRUE);
 564         }
 565
 566         pcode = g_strdup_printf(find_use_code, name);
 567         sv = perl_eval_pv(pcode, TRUE);
 568         g_free(pcode);
 569
 570         if (SvIV(sv)) {
 571                 use_protocols =
 572                         g_slist_append(use_protocols, g_strdup(name));
 573         }
 574
 575         g_free(name);
 576 }
 577
 578 static void free_iobject_hash(void *key, PERL_OBJECT_REC *rec)
 579 {
 580         g_free(rec->stash);
 581         g_free(rec);
 582 }
 583
 584 static int free_iobject_proto(void *key, void *value, void *chat_type)
 585 {
 586         if ((GPOINTER_TO_INT(key) >> 16) == GPOINTER_TO_INT(chat_type)) {
 587                 free_iobject_hash(key, value);
 588                 return TRUE;
 589         }
 590
 591         return FALSE;
 592 }
 593
 594 static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec)
 595 {
 596         GSList *item;
 597
 598         item = gslist_find_icase_string(use_protocols, rec->name);
 599         if (item != NULL) {
 600                 g_free(item->data);
 601                 use_protocols =
 602                         g_slist_remove(use_protocols, item->data);
 603         }
 604         g_hash_table_foreach_remove(iobject_stashes,
 605                                     (GHRFunc) free_iobject_proto,
 606                                     GINT_TO_POINTER(rec->id));
 607 }
 608
 609 void perl_common_start(void)
 610 {
 611         static PLAIN_OBJECT_INIT_REC core_plains[] = {
 612                 { "Irssi::Command", (PERL_OBJECT_FUNC) perl_command_fill_hash },
 613                 { "Irssi::Ignore", (PERL_OBJECT_FUNC) perl_ignore_fill_hash },
 614                 { "Irssi::Log", (PERL_OBJECT_FUNC) perl_log_fill_hash },
 615                 { "Irssi::Logitem", (PERL_OBJECT_FUNC) perl_log_item_fill_hash },
 616                 { "Irssi::Rawlog", (PERL_OBJECT_FUNC) perl_rawlog_fill_hash },
 617                 { "Irssi::Reconnect", (PERL_OBJECT_FUNC) perl_reconnect_fill_hash },
 618
 619                 { NULL, NULL }
 620         };
 621
 622         iobject_stashes = g_hash_table_new((GHashFunc) g_direct_hash,
 623                                         (GCompareFunc) g_direct_equal);
 624         plain_stashes = g_hash_table_new((GHashFunc) g_str_hash,
 625                                          (GCompareFunc) g_str_equal);
 626         irssi_add_plains(core_plains);
 627
 628         use_protocols = NULL;
 629         g_slist_foreach(chat_protocols, (GFunc) perl_register_protocol, NULL);
 630
 631         signal_add("chat protocol created", (SIGNAL_FUNC) perl_register_protocol);
 632         signal_add("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol);
 633 }
 634
 635 void perl_common_stop(void)
 636 {
 637         g_hash_table_foreach(iobject_stashes, (GHFunc) free_iobject_hash, NULL);
 638         g_hash_table_destroy(iobject_stashes);
 639         iobject_stashes = NULL;
 640
 641         g_hash_table_foreach(plain_stashes, (GHFunc) g_free, NULL);
 642         g_hash_table_destroy(plain_stashes);
 643         plain_stashes = NULL;
 644
 645         g_slist_foreach(use_protocols, (GFunc) g_free, NULL);
 646         g_slist_free(use_protocols);
 647         use_protocols = NULL;
 648
 649         signal_remove("chat protocol created", (SIGNAL_FUNC) perl_register_protocol);
 650         signal_remove("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol);
 651 }