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