Mercurial > pidgin
annotate plugins/perl/perl.c @ 5433:19224d2ab31e
[gaim-migrate @ 5815]
add a _() in prefs
committer: Tailor Script <tailor@pidgin.im>
author | Luke Schierer <lschiere@pidgin.im> |
---|---|
date | Sun, 18 May 2003 18:33:02 +0000 |
parents | 2af3224b329a |
children | ad445074d239 |
rev | line source |
---|---|
5205 | 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 #define group perl_group | |
36 #ifdef _WIN32 | |
37 /* This took me an age to figure out.. without this __declspec(dllimport) | |
38 * will be ignored. | |
39 */ | |
40 #define HASATTRIBUTE | |
41 #endif | |
42 #include <EXTERN.h> | |
43 #ifndef _SEM_SEMUN_UNDEFINED | |
44 #define HAS_UNION_SEMUN | |
45 #endif | |
46 #include <perl.h> | |
47 #include <XSUB.h> | |
48 #ifndef _WIN32 | |
49 #include <sys/mman.h> | |
50 #endif | |
51 #include <sys/types.h> | |
52 #include <sys/stat.h> | |
53 #include <fcntl.h> | |
54 #undef PACKAGE | |
55 #include <stdio.h> | |
56 #ifndef _WIN32 | |
57 #include <dirent.h> | |
58 #else | |
59 /* We're using perl's win32 port of this */ | |
60 #define dirent direct | |
61 #endif | |
62 #include <string.h> | |
63 | |
64 #undef group | |
65 | |
66 /* perl module support */ | |
67 #ifdef OLD_PERL | |
68 extern void boot_DynaLoader _((CV * cv)); | |
69 #else | |
70 extern void boot_DynaLoader _((pTHX_ CV * cv)); /* perl is so wacky */ | |
71 #endif | |
72 | |
73 #undef _ | |
74 #ifdef DEBUG | |
75 #undef DEBUG | |
76 #endif | |
77 #ifdef _WIN32 | |
78 #undef pipe | |
79 #endif | |
80 #include "gaim.h" | |
81 #include "prpl.h" | |
82 #include "sound.h" | |
83 | |
84 #ifndef call_pv | |
85 # define call_pv(i,j) perl_call_pv((i), (j)) | |
86 #endif | |
87 | |
88 #define PERL_PLUGIN_ID "core-perl" | |
89 | |
90 struct perlscript { | |
91 char *name; | |
92 char *version; | |
93 char *shutdowncallback; /* bleh */ | |
94 GaimPlugin *plug; | |
95 }; | |
96 | |
97 struct _perl_event_handlers { | |
98 char *event_type; | |
99 char *handler_name; | |
100 GaimPlugin *plug; | |
101 }; | |
102 | |
103 struct _perl_timeout_handlers { | |
104 char *handler_name; | |
105 char *handler_args; | |
106 gint iotag; | |
107 GaimPlugin *plug; | |
108 }; | |
109 | |
110 static GList *perl_list = NULL; | |
111 static GList *perl_timeout_handlers = NULL; | |
112 static GList *perl_event_handlers = NULL; | |
113 static PerlInterpreter *my_perl = NULL; | |
114 static void perl_init(); | |
115 | |
116 /* dealing with gaim */ | |
117 XS(XS_GAIM_register); /* set up hooks for script */ | |
118 XS(XS_GAIM_get_info); /* version, last to attempt signon, protocol */ | |
119 XS(XS_GAIM_print); /* lemme figure this one out... */ | |
120 XS(XS_GAIM_write_to_conv); /* write into conversation window */ | |
121 | |
122 /* list stuff */ | |
123 XS(XS_GAIM_buddy_list); /* all buddies */ | |
124 XS(XS_GAIM_online_list); /* online buddies */ | |
125 | |
126 /* server stuff */ | |
127 XS(XS_GAIM_command); /* send command to server */ | |
128 XS(XS_GAIM_user_info); /* given name, return struct buddy members */ | |
129 XS(XS_GAIM_print_to_conv); /* send message to someone */ | |
130 XS(XS_GAIM_print_to_chat); /* send message to chat room */ | |
131 XS(XS_GAIM_serv_send_im); /* send message to someone (but do not display) */ | |
132 | |
133 /* handler commands */ | |
134 XS(XS_GAIM_add_event_handler); /* when servers talk */ | |
135 XS(XS_GAIM_remove_event_handler); /* remove a handler */ | |
136 XS(XS_GAIM_add_timeout_handler); /* figure it out */ | |
137 | |
138 /* play sound */ | |
139 XS(XS_GAIM_play_sound); /*play a sound */ | |
140 | |
141 static void | |
142 #ifdef OLD_PERL | |
143 xs_init() | |
144 #else | |
145 xs_init(pTHX) | |
146 #endif | |
147 { | |
148 char *file = __FILE__; | |
149 | |
150 /* This one allows dynamic loading of perl modules in perl | |
151 scripts by the 'use perlmod;' construction*/ | |
152 newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); | |
153 | |
154 /* load up all the custom Gaim perl functions */ | |
155 newXS ("GAIM::register", XS_GAIM_register, "GAIM"); | |
156 newXS ("GAIM::get_info", XS_GAIM_get_info, "GAIM"); | |
157 newXS ("GAIM::print", XS_GAIM_print, "GAIM"); | |
158 newXS ("GAIM::write_to_conv", XS_GAIM_write_to_conv, "GAIM"); | |
159 | |
160 newXS ("GAIM::buddy_list", XS_GAIM_buddy_list, "GAIM"); | |
161 newXS ("GAIM::online_list", XS_GAIM_online_list, "GAIM"); | |
162 | |
163 newXS ("GAIM::command", XS_GAIM_command, "GAIM"); | |
164 newXS ("GAIM::user_info", XS_GAIM_user_info, "GAIM"); | |
165 newXS ("GAIM::print_to_conv", XS_GAIM_print_to_conv, "GAIM"); | |
166 newXS ("GAIM::print_to_chat", XS_GAIM_print_to_chat, "GAIM"); | |
167 newXS ("GAIM::serv_send_im", XS_GAIM_serv_send_im, "GAIM"); | |
168 | |
169 newXS ("GAIM::add_event_handler", XS_GAIM_add_event_handler, "GAIM"); | |
170 newXS ("GAIM::remove_event_handler", XS_GAIM_remove_event_handler, "GAIM"); | |
171 newXS ("GAIM::add_timeout_handler", XS_GAIM_add_timeout_handler, "GAIM"); | |
172 | |
173 newXS ("GAIM::play_sound", XS_GAIM_play_sound, "GAIM"); | |
174 } | |
175 | |
176 static char * | |
177 escape_quotes(const char *buf) | |
178 { | |
179 static char *tmp_buf = NULL; | |
180 const char *i; | |
181 char *j; | |
182 | |
183 if (tmp_buf) | |
184 g_free(tmp_buf); | |
185 | |
186 tmp_buf = g_malloc(strlen(buf) * 2 + 1); | |
187 | |
188 for (i = buf, j = tmp_buf; *i; i++, j++) { | |
189 if (*i == '\'' || *i == '\\') | |
190 *j++ = '\\'; | |
191 | |
192 *j = *i; | |
193 } | |
194 | |
195 *j = '\0'; | |
196 | |
197 return tmp_buf; | |
198 } | |
199 | |
200 /* | |
201 2003/02/06: execute_perl modified by Mark Doliner <mark@kingant.net> | |
202 Pass parameters by pushing them onto the stack rather than | |
203 passing an array of strings. This way, perl scripts can | |
204 modify the parameters and we can get the changed values | |
205 and then shoot ourselves. I mean, uh, use them. | |
206 | |
207 2001/06/14: execute_perl replaced by Martin Persson <mep@passagen.se> | |
208 previous use of perl_eval leaked memory, replaced with | |
209 a version that uses perl_call instead | |
210 | |
211 30/11/2002: execute_perl modified by Eric Timme <timothy@voidnet.com> | |
212 args changed to char** so that we can have preparsed | |
213 arguments again, and many headaches ensued! This essentially | |
214 means we replaced one hacked method with a messier hacked | |
215 method out of perceived necessity. Formerly execute_perl | |
216 required a single char_ptr, and it would insert it into an | |
217 array of character pointers and NULL terminate the new array. | |
218 Now we have to pass in pre-terminated character pointer arrays | |
219 to accomodate functions that want to pass in multiple arguments. | |
220 | |
221 Previously arguments were preparsed because an argument list | |
222 was constructed in the form 'arg one','arg two' and was | |
223 executed via a call like &funcname(arglist) (see .59.x), so | |
224 the arglist was magically pre-parsed because of the method. | |
225 With Martin Persson's change to perl_call we now need to | |
226 use a null terminated list of character pointers for arguments | |
227 if we wish them to be parsed. Lacking a better way to allow | |
228 for both single arguments and many I created a NULL terminated | |
229 array in every function that called execute_perl and passed | |
230 that list into the function. In the former version a single | |
231 character pointer was passed in, and was placed into an array | |
232 of character pointers with two elements, with a NULL element | |
233 tacked onto the back, but this method no longer seemed prudent. | |
234 | |
235 Enhancements in the future might be to get rid of pre-declaring | |
236 the array sizes? I am not comfortable enough with this | |
237 subject to attempt it myself and hope it to stand the test | |
238 of time. | |
239 */ | |
240 | |
241 static int | |
242 execute_perl(const char *function, int argc, char **args) | |
243 { | |
244 int count = 0, i, ret_value = 1; | |
245 SV *sv_args[argc]; | |
246 STRLEN na; | |
247 | |
248 /* | |
249 * Set up the perl environment, push arguments onto the | |
250 * perl stack, then call the given function | |
251 */ | |
252 dSP; | |
253 ENTER; | |
254 SAVETMPS; | |
255 PUSHMARK(sp); | |
256 | |
257 for (i = 0; i < argc; i++) { | |
258 if (args[i]) { | |
259 sv_args[i] = sv_2mortal(newSVpv(args[i], 0)); | |
260 XPUSHs(sv_args[i]); | |
261 } | |
262 } | |
263 | |
264 PUTBACK; | |
265 count = call_pv(function, G_EVAL | G_SCALAR); | |
266 SPAGAIN; | |
267 | |
268 /* | |
269 * Check for "die," make sure we have 1 argument, and set our | |
270 * return value. | |
271 */ | |
272 if (SvTRUE(ERRSV)) { | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
273 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
274 "Perl function %s exited abnormally: %s\n", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
275 function, SvPV(ERRSV, na)); |
5205 | 276 POPs; |
277 } | |
278 else if (count != 1) { | |
279 /* | |
280 * This should NEVER happen. G_SCALAR ensures that we WILL | |
281 * have 1 parameter. | |
282 */ | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
283 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
284 "Perl error from %s: expected 1 return value, " |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
285 "but got %d\n", function, count); |
5205 | 286 } |
287 else | |
288 ret_value = POPi; | |
289 | |
290 /* Check for changed arguments */ | |
291 for (i = 0; i < argc; i++) { | |
292 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { | |
293 /* | |
294 * Shizzel. So the perl script changed one of the parameters, | |
295 * and we want this change to affect the original parameters. | |
296 * args[i] is just a tempory little list of pointers. We don't | |
297 * want to free args[i] here because the new parameter doesn't | |
298 * overwrite the data that args[i] points to. That is done by | |
299 * the function that called execute_perl. I'm not explaining this | |
300 * very well. See, it's aggregate... Oh, but if 2 perl scripts | |
301 * both modify the data, _that's_ a memleak. This is really kind | |
302 * of hackish. I should fix it. Look how long this comment is. | |
303 * Holy crap. | |
304 */ | |
305 args[i] = g_strdup(SvPV(sv_args[i], na)); | |
306 } | |
307 } | |
308 | |
309 PUTBACK; | |
310 FREETMPS; | |
311 LEAVE; | |
312 | |
313 return ret_value; | |
314 } | |
315 | |
316 static void | |
317 perl_unload_file(GaimPlugin *plug) | |
318 { | |
319 char *atmp[2] = { "", NULL }; | |
320 struct perlscript *scp = NULL; | |
321 struct _perl_timeout_handlers *thn; | |
322 struct _perl_event_handlers *ehn; | |
323 GList *pl; | |
324 | |
325 for (pl = perl_list; pl != NULL; pl = pl->next) { | |
326 scp = pl->data; | |
327 | |
328 if (scp->plug == plug) { | |
329 perl_list = g_list_remove(perl_list, scp); | |
330 | |
331 if (scp->shutdowncallback[0]) | |
332 execute_perl(scp->shutdowncallback, 1, atmp); | |
333 | |
334 g_free(scp->name); | |
335 g_free(scp->version); | |
336 g_free(scp->shutdowncallback); | |
337 g_free(scp); | |
338 | |
339 break; | |
340 } | |
341 } | |
342 | |
343 for (pl = perl_timeout_handlers; pl != NULL; pl = pl->next) { | |
344 thn = pl->data; | |
345 | |
346 if (thn && thn->plug == plug) { | |
347 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn); | |
348 | |
349 g_source_remove(thn->iotag); | |
350 g_free(thn->handler_args); | |
351 g_free(thn->handler_name); | |
352 g_free(thn); | |
353 } | |
354 } | |
355 | |
356 for (pl = perl_event_handlers; pl != NULL; pl = pl->next) { | |
357 ehn = pl->data; | |
358 | |
359 if (ehn && ehn->plug == plug) { | |
360 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
361 | |
362 g_free(ehn->event_type); | |
363 g_free(ehn->handler_name); | |
364 g_free(ehn); | |
365 } | |
366 } | |
367 } | |
368 | |
369 static int | |
370 perl_load_file(char *script_name, GaimPlugin *plugin) | |
371 { | |
372 char *atmp[2] = { script_name, NULL }; | |
373 GList *s; | |
374 struct perlscript *scp; | |
375 int ret; | |
376 | |
377 if (my_perl == NULL) | |
378 perl_init(); | |
379 | |
380 plugin->handle = plugin->path; | |
381 | |
382 ret = execute_perl("load_n_eval", 1, atmp); | |
383 | |
384 for (s = perl_list; s != NULL; s = s->next) { | |
385 scp = s->data; | |
386 | |
387 if (!strcmp(scp->name, plugin->info->name) && | |
388 !strcmp(scp->version, plugin->info->version)) { | |
389 | |
390 break; | |
391 } | |
392 } | |
393 | |
394 if (!s) { | |
395 plugin->error = g_strdup(_("GAIM::register not called with " | |
396 "proper arguments. Consult PERL-HOWTO.")); | |
397 | |
398 return 0; | |
399 } | |
400 | |
401 return ret; | |
402 } | |
403 | |
404 static void | |
405 perl_init(void) | |
406 { | |
407 /* changed the name of the variable from load_file to | |
408 perl_definitions since now it does much more than defining | |
409 the load_file sub. Moreover, deplaced the initialisation to | |
410 the xs_init function. (TheHobbit)*/ | |
411 char *perl_args[] = { "", "-e", "0", "-w" }; | |
412 char perl_definitions[] = | |
413 { | |
414 /* We use to function one to load a file the other to | |
415 execute the string obtained from the first and holding | |
416 the file conents. This allows to have a realy local $/ | |
417 without introducing temp variables to hold the old | |
418 value. Just a question of style:) */ | |
419 "sub load_file{" | |
420 "my $f_name=shift;" | |
421 "local $/=undef;" | |
422 "open FH,$f_name or return \"__FAILED__\";" | |
423 "$_=<FH>;" | |
424 "close FH;" | |
425 "return $_;" | |
426 "}" | |
427 "sub load_n_eval{" | |
428 "my $f_name=shift;" | |
429 "my $strin=load_file($f_name);" | |
430 "return 2 if($strin eq \"__FAILED__\");" | |
431 "eval $strin;" | |
432 "if($@){" | |
433 /*" #something went wrong\n"*/ | |
434 "GAIM::print(\"Errors loading file $f_name:\\n\",\"$@\");" | |
435 "return 1;" | |
436 "}" | |
437 "return 0;" | |
438 "}" | |
439 }; | |
440 | |
441 my_perl = perl_alloc(); | |
442 perl_construct(my_perl); | |
443 #ifdef DEBUG | |
444 perl_parse(my_perl, xs_init, 4, perl_args, NULL); | |
445 #else | |
446 perl_parse(my_perl, xs_init, 3, perl_args, NULL); | |
447 #endif | |
448 #ifdef HAVE_PERL_EVAL_PV | |
449 eval_pv(perl_definitions, TRUE); | |
450 #else | |
451 perl_eval_pv(perl_definitions, TRUE); /* deprecated */ | |
452 #endif | |
453 } | |
454 | |
455 static void | |
456 perl_end(void) | |
457 { | |
458 char *atmp[2] = { "", NULL }; | |
459 struct perlscript *scp; | |
460 struct _perl_timeout_handlers *thn; | |
461 struct _perl_event_handlers *ehn; | |
462 | |
463 while (perl_list) { | |
464 scp = perl_list->data; | |
465 perl_list = g_list_remove(perl_list, scp); | |
466 | |
467 if (scp->shutdowncallback[0]) | |
468 execute_perl(scp->shutdowncallback, 1, atmp); | |
469 | |
470 g_free(scp->name); | |
471 g_free(scp->version); | |
472 g_free(scp->shutdowncallback); | |
473 g_free(scp); | |
474 } | |
475 | |
476 while (perl_timeout_handlers) { | |
477 thn = perl_timeout_handlers->data; | |
478 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn); | |
479 g_source_remove(thn->iotag); | |
480 g_free(thn->handler_args); | |
481 g_free(thn->handler_name); | |
482 g_free(thn); | |
483 } | |
484 | |
485 while (perl_event_handlers) { | |
486 ehn = perl_event_handlers->data; | |
487 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
488 g_free(ehn->event_type); | |
489 g_free(ehn->handler_name); | |
490 g_free(ehn); | |
491 } | |
492 | |
493 if (my_perl != NULL) { | |
494 perl_destruct(my_perl); | |
495 perl_free(my_perl); | |
496 my_perl = NULL; | |
497 } | |
498 } | |
499 | |
500 XS (XS_GAIM_register) | |
501 { | |
502 char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */ | |
503 unsigned int junk; | |
504 struct perlscript *scp; | |
505 GaimPlugin *plug = NULL; | |
506 GList *pl; | |
507 | |
508 dXSARGS; | |
509 items = 0; | |
510 | |
511 name = SvPV(ST(0), junk); | |
512 ver = SvPV(ST(1), junk); | |
513 callback = SvPV(ST(2), junk); | |
514 unused = SvPV(ST(3), junk); | |
515 | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
516 gaim_debug(GAIM_DEBUG_INFO, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
517 "GAIM::register(%s, %s)\n", name, ver); |
5205 | 518 |
519 for (pl = gaim_plugins_get_all(); pl != NULL; pl = pl->next) { | |
520 plug = pl->data; | |
521 | |
522 if (!strcmp(name, plug->info->name) && | |
523 !strcmp(ver, plug->info->version)) { | |
524 | |
525 break; | |
526 } | |
527 | |
528 plug = NULL; | |
529 } | |
530 | |
531 if (plug) { | |
532 scp = g_new0(struct perlscript, 1); | |
533 scp->name = g_strdup(name); | |
534 scp->version = g_strdup(ver); | |
535 scp->shutdowncallback = g_strdup(callback); | |
536 scp->plug = plug; | |
537 | |
538 perl_list = g_list_append(perl_list, scp); | |
539 | |
540 XST_mPV(0, plug->path); | |
541 } | |
542 else | |
543 XST_mPV(0, NULL); | |
544 | |
545 XSRETURN (1); | |
546 } | |
547 | |
548 XS (XS_GAIM_get_info) | |
549 { | |
550 int i = 0; | |
551 dXSARGS; | |
552 items = 0; | |
553 | |
554 switch(SvIV(ST(0))) { | |
555 case 0: | |
556 XST_mPV(0, VERSION); | |
557 i = 1; | |
558 break; | |
559 | |
560 case 1: | |
561 { | |
562 GSList *c = connections; | |
563 struct gaim_connection *gc; | |
564 | |
565 while (c) { | |
566 gc = (struct gaim_connection *)c->data; | |
567 XST_mIV(i++, (guint)gc); | |
568 c = c->next; | |
569 } | |
570 } | |
571 break; | |
572 | |
573 case 2: | |
574 { | |
575 struct gaim_connection *gc = | |
576 (struct gaim_connection *)SvIV(ST(1)); | |
577 | |
578 if (g_slist_find(connections, gc)) | |
579 XST_mIV(i++, gc->protocol); | |
580 else | |
581 XST_mIV(i++, -1); | |
582 } | |
583 break; | |
584 | |
585 case 3: | |
586 { | |
587 struct gaim_connection *gc = | |
588 (struct gaim_connection *)SvIV(ST(1)); | |
589 | |
590 if (g_slist_find(connections, gc)) | |
591 XST_mPV(i++, gc->username); | |
592 else | |
593 XST_mPV(i++, ""); | |
594 } | |
595 break; | |
596 | |
597 case 4: | |
598 { | |
599 struct gaim_connection *gc = | |
600 (struct gaim_connection *)SvIV(ST(1)); | |
601 | |
602 if (g_slist_find(connections, gc)) | |
603 XST_mIV(i++, g_slist_index(gaim_accounts, gc->account)); | |
604 else | |
605 XST_mIV(i++, -1); | |
606 } | |
607 break; | |
608 | |
609 case 5: | |
610 { | |
611 GSList *a = gaim_accounts; | |
612 while (a) { | |
613 struct gaim_account *account = a->data; | |
614 XST_mPV(i++, account->username); | |
615 a = a->next; | |
616 } | |
617 } | |
618 break; | |
619 | |
620 case 6: | |
621 { | |
622 GSList *a = gaim_accounts; | |
623 while (a) { | |
624 struct gaim_account *account = a->data; | |
625 XST_mIV(i++, account->protocol); | |
626 a = a->next; | |
627 } | |
628 } | |
629 break; | |
630 | |
631 case 7: | |
632 { | |
633 struct gaim_connection *gc = | |
634 (struct gaim_connection *)SvIV(ST(1)); | |
635 | |
636 if (g_slist_find(connections, gc)) | |
637 XST_mPV(i++, gc->prpl->info->name); | |
638 else | |
639 XST_mPV(i++, "Unknown"); | |
640 } | |
641 break; | |
642 | |
643 default: | |
644 XST_mPV(0, "Error2"); | |
645 i = 1; | |
646 } | |
647 | |
648 XSRETURN(i); | |
649 } | |
650 | |
651 XS (XS_GAIM_print) | |
652 { | |
653 char *title; | |
654 char *message; | |
655 unsigned int junk; | |
656 dXSARGS; | |
657 items = 0; | |
658 | |
659 title = SvPV(ST(0), junk); | |
660 message = SvPV(ST(1), junk); | |
661 do_error_dialog(title, message, GAIM_INFO); | |
662 XSRETURN(0); | |
663 } | |
664 | |
665 XS (XS_GAIM_buddy_list) | |
666 { | |
667 struct gaim_connection *gc; | |
668 struct buddy *buddy; | |
669 struct group *g; | |
670 GaimBlistNode *gnode,*bnode; | |
671 int i = 0; | |
672 dXSARGS; | |
673 items = 0; | |
674 | |
675 gc = (struct gaim_connection *)SvIV(ST(0)); | |
676 | |
677 for(gnode = gaim_get_blist()->root; gnode; gnode = gnode->next) { | |
678 if(!GAIM_BLIST_NODE_IS_GROUP(gnode)) | |
679 continue; | |
680 g = (struct group *)gnode; | |
681 for(bnode = gnode->child; bnode; bnode = bnode->next) { | |
682 if(!GAIM_BLIST_NODE_IS_BUDDY(bnode)) | |
683 continue; | |
684 buddy = (struct buddy *)bnode; | |
685 if(buddy->account == gc->account) | |
686 XST_mPV(i++, buddy->name); | |
687 } | |
688 } | |
689 XSRETURN(i); | |
690 } | |
691 | |
692 XS (XS_GAIM_online_list) | |
693 { | |
694 struct gaim_connection *gc; | |
695 struct buddy *b; | |
696 struct group *g; | |
697 GaimBlistNode *gnode,*bnode; | |
698 int i = 0; | |
699 dXSARGS; | |
700 items = 0; | |
701 | |
702 gc = (struct gaim_connection *)SvIV(ST(0)); | |
703 | |
704 for(gnode = gaim_get_blist()->root; gnode; gnode = gnode->next) { | |
705 if(!GAIM_BLIST_NODE_IS_GROUP(gnode)) | |
706 continue; | |
707 g = (struct group *)gnode; | |
708 for(bnode = gnode->child; bnode; bnode = bnode->next) { | |
709 if(!GAIM_BLIST_NODE_IS_BUDDY(bnode)) | |
710 continue; | |
711 b = (struct buddy *)bnode; | |
712 if (b->account == gc->account && GAIM_BUDDY_IS_ONLINE(b)) XST_mPV(i++, b->name); | |
713 } | |
714 } | |
715 XSRETURN(i); | |
716 } | |
717 | |
718 XS (XS_GAIM_command) | |
719 { | |
720 unsigned int junk; | |
721 char *command = NULL; | |
722 dXSARGS; | |
723 items = 0; | |
724 | |
725 command = SvPV(ST(0), junk); | |
726 if (!command) XSRETURN(0); | |
727 if (!strncasecmp(command, "signon", 6)) { | |
728 int index = SvIV(ST(1)); | |
729 if (g_slist_nth_data(gaim_accounts, index)) | |
730 serv_login(g_slist_nth_data(gaim_accounts, index)); | |
731 } else if (!strncasecmp(command, "signoff", 7)) { | |
732 struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1)); | |
733 if (g_slist_find(connections, gc)) signoff(gc); | |
734 else signoff_all(NULL, NULL); | |
735 } else if (!strncasecmp(command, "info", 4)) { | |
736 struct gaim_connection *gc = (struct gaim_connection *)SvIV(ST(1)); | |
737 if (g_slist_find(connections, gc)) | |
738 serv_set_info(gc, SvPV(ST(2), junk)); | |
739 } else if (!strncasecmp(command, "away", 4)) { | |
740 char *message = SvPV(ST(1), junk); | |
741 static struct away_message a; | |
742 g_snprintf(a.message, sizeof(a.message), "%s", message); | |
743 do_away_message(NULL, &a); | |
744 } else if (!strncasecmp(command, "back", 4)) { | |
745 do_im_back(); | |
746 } else if (!strncasecmp(command, "idle", 4)) { | |
747 GSList *c = connections; | |
748 struct gaim_connection *gc; | |
749 | |
750 while (c) { | |
751 gc = (struct gaim_connection *)c->data; | |
752 serv_set_idle(gc, SvIV(ST(1))); | |
753 c = c->next; | |
754 } | |
755 } else if (!strncasecmp(command, "warn", 4)) { | |
756 GSList *c = connections; | |
757 struct gaim_connection *gc; | |
758 | |
759 while (c) { | |
760 gc = (struct gaim_connection *)c->data; | |
761 serv_warn(gc, SvPV(ST(1), junk), SvIV(ST(2))); | |
762 c = c->next; | |
763 } | |
764 } | |
765 | |
766 XSRETURN(0); | |
767 } | |
768 | |
769 XS (XS_GAIM_user_info) | |
770 { | |
771 struct gaim_connection *gc; | |
772 unsigned int junk; | |
773 struct buddy *buddy = NULL; | |
774 dXSARGS; | |
775 items = 0; | |
776 | |
777 gc = (struct gaim_connection *)SvIV(ST(0)); | |
778 if (g_slist_find(connections, gc)) | |
779 buddy = gaim_find_buddy(gc->account, SvPV(ST(1), junk)); | |
780 | |
781 if (!buddy) | |
782 XSRETURN(0); | |
783 XST_mPV(0, buddy->name); | |
784 XST_mPV(1, gaim_get_buddy_alias(buddy)); | |
785 XST_mPV(2, GAIM_BUDDY_IS_ONLINE(buddy) ? "Online" : "Offline"); | |
786 XST_mIV(3, buddy->evil); | |
787 XST_mIV(4, buddy->signon); | |
788 XST_mIV(5, buddy->idle); | |
789 XSRETURN(6); | |
790 } | |
791 | |
792 XS (XS_GAIM_write_to_conv) | |
793 { | |
794 char *nick, *who, *what; | |
795 struct gaim_conversation *c; | |
796 int junk; | |
797 int send, wflags; | |
798 dXSARGS; | |
799 items = 0; | |
800 | |
801 nick = SvPV(ST(0), junk); | |
802 send = SvIV(ST(1)); | |
803 what = SvPV(ST(2), junk); | |
804 who = SvPV(ST(3), junk); | |
805 | |
806 if (!*who) who=NULL; | |
807 | |
808 switch (send) { | |
809 case 0: wflags=WFLAG_SEND; break; | |
810 case 1: wflags=WFLAG_RECV; break; | |
811 case 2: wflags=WFLAG_SYSTEM; break; | |
812 default: wflags=WFLAG_RECV; | |
813 } | |
814 | |
815 c = gaim_find_conversation(nick); | |
816 | |
817 if (!c) | |
818 c = gaim_conversation_new(GAIM_CONV_IM, NULL, nick); | |
819 | |
820 gaim_conversation_write(c, who, what, -1, wflags, time(NULL)); | |
821 XSRETURN(0); | |
822 } | |
823 | |
824 XS (XS_GAIM_serv_send_im) | |
825 { | |
826 struct gaim_connection *gc; | |
827 char *nick, *what; | |
828 int isauto; | |
829 int junk; | |
830 dXSARGS; | |
831 items = 0; | |
832 | |
833 gc = (struct gaim_connection *)SvIV(ST(0)); | |
834 nick = SvPV(ST(1), junk); | |
835 what = SvPV(ST(2), junk); | |
836 isauto = SvIV(ST(3)); | |
837 | |
838 if (!g_slist_find(connections, gc)) { | |
839 XSRETURN(0); | |
840 return; | |
841 } | |
842 serv_send_im(gc, nick, what, -1, isauto); | |
843 XSRETURN(0); | |
844 } | |
845 | |
846 XS (XS_GAIM_print_to_conv) | |
847 { | |
848 struct gaim_connection *gc; | |
849 char *nick, *what; | |
850 int isauto; | |
851 struct gaim_conversation *c; | |
852 unsigned int junk; | |
853 dXSARGS; | |
854 items = 0; | |
855 | |
856 gc = (struct gaim_connection *)SvIV(ST(0)); | |
857 nick = SvPV(ST(1), junk); | |
858 what = SvPV(ST(2), junk); | |
859 isauto = SvIV(ST(3)); | |
860 if (!g_slist_find(connections, gc)) { | |
861 XSRETURN(0); | |
862 return; | |
863 } | |
864 | |
865 c = gaim_find_conversation(nick); | |
866 | |
867 if (!c) | |
868 c = gaim_conversation_new(GAIM_CONV_IM, gc->account, nick); | |
869 else | |
870 gaim_conversation_set_account(c, gc->account); | |
871 | |
872 gaim_conversation_write(c, NULL, what, -1, | |
873 (WFLAG_SEND | (isauto ? WFLAG_AUTO : 0)), time(NULL)); | |
874 serv_send_im(gc, nick, what, -1, isauto ? IM_FLAG_AWAY : 0); | |
875 XSRETURN(0); | |
876 } | |
877 | |
878 | |
879 | |
880 XS (XS_GAIM_print_to_chat) | |
881 { | |
882 struct gaim_connection *gc; | |
883 int id; | |
884 char *what; | |
885 struct gaim_conversation *b = NULL; | |
886 GSList *bcs; | |
887 unsigned int junk; | |
888 dXSARGS; | |
889 items = 0; | |
890 | |
891 gc = (struct gaim_connection *)SvIV(ST(0)); | |
892 id = SvIV(ST(1)); | |
893 what = SvPV(ST(2), junk); | |
894 | |
895 if (!g_slist_find(connections, gc)) { | |
896 XSRETURN(0); | |
897 return; | |
898 } | |
899 bcs = gc->buddy_chats; | |
900 while (bcs) { | |
901 b = (struct gaim_conversation *)bcs->data; | |
902 | |
903 if (gaim_chat_get_id(gaim_conversation_get_chat_data(b)) == id) | |
904 break; | |
905 bcs = bcs->next; | |
906 b = NULL; | |
907 } | |
908 if (b) | |
909 serv_chat_send(gc, id, what); | |
910 XSRETURN(0); | |
911 } | |
912 | |
913 static int | |
914 perl_event(GaimEvent event, void *unused, va_list args) | |
915 { | |
916 char *buf[5] = { NULL, NULL, NULL, NULL, NULL }; /* Maximum of 5 args */ | |
917 void *arg1 = NULL, *arg2 = NULL, *arg3 = NULL, *arg4 = NULL, *arg5 = NULL; | |
918 char tmpbuf1[16], tmpbuf2[16], tmpbuf3[1]; | |
919 GList *handler; | |
920 struct _perl_event_handlers *data; | |
921 int handler_return; | |
922 | |
923 arg1 = va_arg(args, void *); | |
924 arg2 = va_arg(args, void *); | |
925 arg3 = va_arg(args, void *); | |
926 arg4 = va_arg(args, void *); | |
927 arg5 = va_arg(args, void *); | |
928 | |
929 tmpbuf1[0] = '\0'; | |
930 tmpbuf2[0] = '\0'; | |
931 tmpbuf3[0] = '\0'; | |
932 | |
933 /* Make a pretty array of char*'s with which to call perl functions */ | |
934 switch (event) { | |
5408
2af3224b329a
[gaim-migrate @ 5784]
Christian Hammond <chipx86@chipx86.com>
parents:
5227
diff
changeset
|
935 case event_connecting: |
5205 | 936 case event_signon: |
937 case event_signoff: | |
938 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
939 buf[0] = tmpbuf1; | |
940 break; | |
941 case event_away: | |
942 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
943 buf[0] = tmpbuf1; | |
944 buf[1] = ((struct gaim_connection *)arg1)->away ? | |
945 ((struct gaim_connection *)arg1)->away : tmpbuf2; | |
946 break; | |
947 case event_im_recv: | |
948 if (!*(char**)arg2 || !*(char**)arg3) return 1; | |
949 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
950 buf[0] = tmpbuf1; | |
951 buf[1] = *(char **)arg2; | |
952 buf[2] = *(char **)arg3; | |
953 break; | |
954 case event_im_send: | |
955 if (!*(char**)arg3) return 1; | |
956 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
957 buf[0] = tmpbuf1; | |
958 buf[1] = arg2 ? arg2 : tmpbuf3; | |
959 buf[2] = *(char **)arg3; | |
960 break; | |
961 case event_buddy_signon: | |
962 case event_buddy_signoff: | |
963 case event_set_info: | |
964 case event_buddy_away: | |
965 case event_buddy_back: | |
966 case event_buddy_idle: | |
967 case event_buddy_unidle: | |
968 case event_got_typing: | |
969 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
970 buf[0] = tmpbuf1; | |
971 buf[1] = arg2; | |
972 break; | |
973 case event_chat_invited: | |
974 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
975 buf[0] = tmpbuf1; | |
976 buf[1] = arg2; | |
977 buf[2] = arg3; | |
978 buf[3] = arg4; | |
979 break; | |
980 case event_chat_join: | |
981 case event_chat_buddy_join: | |
982 case event_chat_buddy_leave: | |
983 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
984 buf[0] = tmpbuf1; | |
985 g_snprintf(tmpbuf2, 16, "%d", (int)arg2); | |
986 buf[1] = tmpbuf2; | |
987 buf[2] = arg3; | |
988 break; | |
989 case event_chat_leave: | |
990 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
991 buf[0] = tmpbuf1; | |
992 g_snprintf(tmpbuf2, 16, "%d", (int)arg2); | |
993 buf[1] = tmpbuf2; | |
994 break; | |
995 case event_chat_recv: | |
996 if (!*(char**)arg3 || !*(char**)arg4) return 1; | |
997 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
998 buf[0] = tmpbuf1; | |
999 g_snprintf(tmpbuf2, 16, "%d", (int)arg2); | |
1000 buf[1] = tmpbuf2; | |
1001 buf[2] = *(char **)arg3; | |
1002 buf[3] = *(char **)arg4; | |
1003 break; | |
1004 case event_chat_send_invite: | |
1005 if (!*(char**)arg4) return 1; | |
1006 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
1007 buf[0] = tmpbuf1; | |
1008 g_snprintf(tmpbuf2, 16, "%d", (int)arg2); | |
1009 buf[1] = tmpbuf2; | |
1010 buf[2] = arg3; | |
1011 buf[3] = *(char **)arg4; | |
1012 break; | |
1013 case event_chat_send: | |
1014 if (!*(char**)arg3) return 1; | |
1015 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
1016 buf[0] = tmpbuf1; | |
1017 g_snprintf(tmpbuf2, 16, "%d", (int)arg2); | |
1018 buf[1] = tmpbuf2; | |
1019 buf[2] = *(char **)arg3; | |
1020 break; | |
1021 case event_warned: | |
1022 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
1023 buf[0] = tmpbuf1; | |
1024 buf[1] = arg2 ? arg2 : tmpbuf3; | |
1025 g_snprintf(tmpbuf2, 16, "%d", (int)arg3); | |
1026 buf[2] = tmpbuf2; | |
1027 break; | |
1028 case event_quit: | |
1029 case event_blist_update: | |
1030 buf[0] = tmpbuf3; | |
1031 break; | |
1032 case event_new_conversation: | |
1033 case event_del_conversation: | |
1034 buf[0] = arg1; | |
1035 break; | |
1036 case event_im_displayed_sent: | |
1037 if (!*(char**)arg3) return 1; | |
1038 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
1039 buf[0] = tmpbuf1; | |
1040 buf[1] = arg2; | |
1041 buf[2] = *(char **)arg3; | |
1042 break; | |
1043 case event_im_displayed_rcvd: | |
1044 g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1); | |
1045 buf[0] = tmpbuf1; | |
1046 buf[1] = arg2; | |
1047 buf[2] = arg3 ? arg3 : tmpbuf3; | |
1048 break; | |
1049 case event_draw_menu: | |
1050 /* we can't handle this usefully without gtk/perl bindings */ | |
1051 return 0; | |
1052 default: | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1053 gaim_debug(GAIM_DEBUG_WARNING, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1054 "Someone forgot to handle %s in the perl binding\n", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1055 gaim_event_get_name(event)); |
5205 | 1056 return 0; |
1057 } | |
1058 | |
1059 /* Call any applicable functions */ | |
1060 for (handler = perl_event_handlers; | |
1061 handler != NULL; | |
1062 handler = handler->next) { | |
1063 | |
1064 data = handler->data; | |
1065 | |
1066 if (!strcmp(gaim_event_get_name(event), data->event_type)) { | |
1067 | |
1068 handler_return = execute_perl(data->handler_name, 5, buf); | |
1069 | |
1070 if (handler_return) | |
1071 return handler_return; | |
1072 } | |
1073 } | |
1074 | |
1075 /* Now make changes from perl scripts affect the real data */ | |
1076 switch (event) { | |
1077 case event_im_recv: | |
1078 if (buf[1] != *(char **)arg2) { | |
1079 free(*(char **)arg2); | |
1080 *(char **)arg2 = buf[1]; | |
1081 } | |
1082 if (buf[2] != *(char **)arg3) { | |
1083 free(*(char **)arg3); | |
1084 *(char **)arg3 = buf[2]; | |
1085 } | |
1086 break; | |
1087 case event_im_send: | |
1088 if (buf[2] != *(char **)arg3) { | |
1089 free(*(char **)arg3); | |
1090 *(char **)arg3 = buf[2]; | |
1091 } | |
1092 break; | |
1093 case event_chat_recv: | |
1094 if (buf[2] != *(char **)arg3) { | |
1095 free(*(char **)arg3); | |
1096 *(char **)arg3 = buf[2]; | |
1097 } | |
1098 if (buf[3] != *(char **)arg4) { | |
1099 free(*(char **)arg4); | |
1100 *(char **)arg4 = buf[3]; | |
1101 } | |
1102 break; | |
1103 case event_chat_send_invite: | |
1104 if (buf[3] != *(char **)arg4) { | |
1105 free(*(char **)arg4); | |
1106 *(char **)arg4 = buf[3]; | |
1107 } | |
1108 break; | |
1109 case event_chat_send: | |
1110 if (buf[2] != *(char **)arg3) { | |
1111 free(*(char **)arg3); | |
1112 *(char **)arg3 = buf[2]; | |
1113 } | |
1114 break; | |
1115 case event_im_displayed_sent: | |
1116 if (buf[2] != *(char **)arg3) { | |
1117 free(*(char **)arg3); | |
1118 *(char **)arg3 = buf[2]; | |
1119 } | |
1120 break; | |
1121 default: | |
1122 break; | |
1123 } | |
1124 | |
1125 return 0; | |
1126 } | |
1127 | |
1128 XS (XS_GAIM_add_event_handler) | |
1129 { | |
1130 unsigned int junk; | |
1131 struct _perl_event_handlers *handler; | |
1132 char *handle; | |
1133 GaimPlugin *plug; | |
1134 GList *p; | |
1135 dXSARGS; | |
1136 items = 0; | |
1137 | |
1138 handle = SvPV(ST(0), junk); | |
1139 | |
1140 for (p = gaim_plugins_get_all(); p != NULL; p = p->next) { | |
1141 plug = p->data; | |
1142 | |
1143 if (!strcmp(handle, plug->path)) | |
1144 break; | |
1145 } | |
1146 | |
1147 if (p) { | |
1148 handler = g_new0(struct _perl_event_handlers, 1); | |
1149 handler->event_type = g_strdup(SvPV(ST(1), junk)); | |
1150 handler->handler_name = g_strdup(SvPV(ST(2), junk)); | |
1151 handler->plug = plug; | |
1152 perl_event_handlers = g_list_append(perl_event_handlers, handler); | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1153 gaim_debug(GAIM_DEBUG_INFO, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1154 "Registered perl event handler for %s\n", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1155 handler->event_type); |
5205 | 1156 } else { |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1157 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1158 "Invalid handle (%s) registering perl event handler\n", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1159 handle); |
5205 | 1160 } |
1161 | |
1162 XSRETURN_EMPTY; | |
1163 } | |
1164 | |
1165 XS (XS_GAIM_remove_event_handler) | |
1166 { | |
1167 unsigned int junk; | |
1168 struct _perl_event_handlers *ehn; | |
1169 GList *cur = perl_event_handlers; | |
1170 dXSARGS; | |
1171 items = 0; | |
1172 | |
1173 while (cur) { | |
1174 GList *next = cur->next; | |
1175 ehn = cur->data; | |
1176 | |
1177 if (!strcmp(ehn->event_type, SvPV(ST(0), junk)) && | |
1178 !strcmp(ehn->handler_name, SvPV(ST(1), junk))) | |
1179 { | |
1180 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
1181 g_free(ehn->event_type); | |
1182 g_free(ehn->handler_name); | |
1183 g_free(ehn); | |
1184 } | |
1185 | |
1186 cur = next; | |
1187 } | |
1188 } | |
1189 | |
1190 static int | |
1191 perl_timeout(gpointer data) | |
1192 { | |
1193 char *atmp[2] = { NULL, NULL }; | |
1194 struct _perl_timeout_handlers *handler = data; | |
1195 | |
1196 atmp[0] = escape_quotes(handler->handler_args); | |
1197 execute_perl(handler->handler_name, 1, atmp); | |
1198 | |
1199 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler); | |
1200 g_free(handler->handler_args); | |
1201 g_free(handler->handler_name); | |
1202 g_free(handler); | |
1203 | |
1204 return 0; /* returning zero removes the timeout handler */ | |
1205 } | |
1206 | |
1207 XS (XS_GAIM_add_timeout_handler) | |
1208 { | |
1209 unsigned int junk; | |
1210 long timeout; | |
1211 struct _perl_timeout_handlers *handler; | |
1212 char *handle; | |
1213 GaimPlugin *plug; | |
1214 GList *p; | |
1215 | |
1216 dXSARGS; | |
1217 items = 0; | |
1218 | |
1219 handle = SvPV(ST(0), junk); | |
1220 | |
1221 for (p = gaim_plugins_get_all(); p != NULL; p = p->next) { | |
1222 plug = p->data; | |
1223 | |
1224 if (!strcmp(handle, plug->path)) | |
1225 break; | |
1226 } | |
1227 | |
1228 if (p) { | |
1229 handler = g_new0(struct _perl_timeout_handlers, 1); | |
1230 timeout = 1000 * SvIV(ST(1)); | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1231 gaim_debug(GAIM_DEBUG_INFO, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1232 "Adding timeout for %ld seconds.\n", timeout/1000); |
5205 | 1233 handler->plug = plug; |
1234 handler->handler_name = g_strdup(SvPV(ST(2), junk)); | |
1235 handler->handler_args = g_strdup(SvPV(ST(3), junk)); | |
1236 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler); | |
1237 handler->iotag = g_timeout_add(timeout, perl_timeout, handler); | |
1238 } else { | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1239 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1240 "Invalid handle (%s) in adding perl timeout handler.", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
1241 handle); |
5205 | 1242 } |
1243 XSRETURN_EMPTY; | |
1244 } | |
1245 | |
1246 XS (XS_GAIM_play_sound) | |
1247 { | |
1248 int id; | |
1249 dXSARGS; | |
1250 | |
1251 items = 0; | |
1252 | |
1253 id = SvIV(ST(0)); | |
1254 | |
1255 gaim_sound_play_event(id); | |
1256 | |
1257 XSRETURN_EMPTY; | |
1258 } | |
1259 | |
1260 static gboolean | |
1261 probe_perl_plugin(GaimPlugin *plugin) | |
1262 { | |
1263 /* XXX This would be much faster if I didn't create a new | |
1264 * PerlInterpreter every time I probed a plugin */ | |
1265 | |
1266 GaimPluginInfo *info; | |
1267 PerlInterpreter *prober = perl_alloc(); | |
1268 char *argv[] = {"", plugin->path }; | |
1269 int count; | |
1270 gboolean status = TRUE; | |
1271 | |
1272 perl_construct(prober); | |
1273 perl_parse(prober, NULL, 2, argv, NULL); | |
1274 | |
1275 { | |
1276 dSP; | |
1277 ENTER; | |
1278 SAVETMPS; | |
1279 PUSHMARK(SP); | |
1280 | |
1281 count = perl_call_pv("description", G_NOARGS | G_ARRAY | G_EVAL); | |
1282 SPAGAIN; | |
1283 | |
1284 if (count == 6) { | |
1285 info = g_new0(GaimPluginInfo, 1); | |
1286 | |
1287 info->api_version = 2; | |
1288 info->type = GAIM_PLUGIN_STANDARD; | |
1289 | |
1290 info->dependencies = g_list_append(info->dependencies, | |
1291 PERL_PLUGIN_ID); | |
1292 | |
1293 POPp; /* iconfile */ | |
1294 | |
1295 info->homepage = g_strdup(POPp); | |
1296 info->author = g_strdup(POPp); | |
1297 info->description = g_strdup(POPp); | |
1298 info->version = g_strdup(POPp); | |
1299 info->name = g_strdup(POPp); | |
1300 | |
1301 plugin->info = info; | |
1302 | |
1303 if (!gaim_plugin_register(plugin)) | |
1304 status = FALSE; | |
1305 } | |
1306 else | |
1307 status = FALSE; | |
1308 | |
1309 PUTBACK; | |
1310 FREETMPS; | |
1311 LEAVE; | |
1312 } | |
1313 | |
1314 perl_destruct(prober); | |
1315 perl_free(prober); | |
1316 | |
1317 return status; | |
1318 } | |
1319 | |
1320 static gboolean | |
1321 load_perl_plugin(GaimPlugin *plugin) | |
1322 { | |
1323 perl_load_file(plugin->path, plugin); | |
1324 | |
1325 return TRUE; | |
1326 } | |
1327 | |
1328 static gboolean | |
1329 unload_perl_plugin(GaimPlugin *plugin) | |
1330 { | |
1331 perl_unload_file(plugin); | |
1332 | |
1333 return TRUE; | |
1334 } | |
1335 | |
1336 static void | |
1337 destroy_perl_plugin(GaimPlugin *plugin) | |
1338 { | |
1339 if (plugin->info != NULL) { | |
1340 g_free(plugin->info->name); | |
1341 g_free(plugin->info->version); | |
1342 g_free(plugin->info->description); | |
1343 g_free(plugin->info->author); | |
1344 g_free(plugin->info->homepage); | |
1345 } | |
1346 } | |
1347 | |
1348 static gboolean | |
1349 plugin_unload(GaimPlugin *plugin) | |
1350 { | |
1351 perl_end(); | |
1352 | |
1353 return TRUE; | |
1354 } | |
1355 | |
1356 static GaimPluginLoaderInfo loader_info = | |
1357 { | |
1358 NULL, /**< exts */ | |
1359 | |
1360 probe_perl_plugin, /**< probe */ | |
1361 load_perl_plugin, /**< load */ | |
1362 unload_perl_plugin, /**< unload */ | |
1363 destroy_perl_plugin, /**< destroy */ | |
1364 perl_event /**< broadcast */ | |
1365 }; | |
1366 | |
1367 static GaimPluginInfo info = | |
1368 { | |
1369 2, /**< api_version */ | |
1370 GAIM_PLUGIN_LOADER, /**< type */ | |
1371 NULL, /**< ui_requirement */ | |
1372 0, /**< flags */ | |
1373 NULL, /**< dependencies */ | |
1374 GAIM_PRIORITY_DEFAULT, /**< priority */ | |
1375 | |
1376 PERL_PLUGIN_ID, /**< id */ | |
1377 N_("Perl Plugin Loader"), /**< name */ | |
1378 VERSION, /**< version */ | |
1379 N_("Provides support for loading perl plugins."), /**< summary */ | |
1380 N_("Provides support for loading perl plugins."), /**< description */ | |
1381 "Christian Hammond <chipx86@gnupdate.org>", /**< author */ | |
1382 WEBSITE, /**< homepage */ | |
1383 | |
1384 NULL, /**< load */ | |
1385 plugin_unload, /**< unload */ | |
1386 NULL, /**< destroy */ | |
1387 | |
1388 NULL, /**< ui_info */ | |
1389 &loader_info /**< extra_info */ | |
1390 }; | |
1391 | |
1392 static void | |
1393 __init_plugin(GaimPlugin *plugin) | |
1394 { | |
1395 loader_info.exts = g_list_append(loader_info.exts, "pl"); | |
1396 } | |
1397 | |
1398 GAIM_INIT_PLUGIN(perl, __init_plugin, info); |