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