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