Mercurial > pidgin
comparison plugins/perl/perl.c @ 5205:fefad67de2c7
[gaim-migrate @ 5573]
I had a damn good commit message, but it was eaten. Let's try it again.
Announcing, Gaim Plugin API version 2.0, or GPAPIV2.0 for short.
There are lots'a cool thingies here.
Okay now, this isn't as cool as the previous message, but:
1) There's now a single entry function for all plugin types. It returns a
detailed information structure on the plugin. This removes a lot of the
ugliness from old plugins. Oh yeah, libicq wasn't converted to this, so
if you use it, well, you shouldn't have used it anyway, but now you
can't! bwahahaha. Use AIM/ICQ.
2) There are now 3 types of plugins: Standard, Loader, and Protocol
plugins.
Standard plugins are, well, standard, compiled plugins.
Loader plugins load other plugins. For example, the perl support is now
a loader plugin. It loads perl scripts. In the future, we'll have
Ruby and Python loader plugins.
Protocol plugins are, well, protocol plugins... yeah...
3) Plugins have unique IDs, so they can be referred to or automatically
updated from a plugin database in the future. Neat, huh?
4) Plugins will have dependency support in the future, and can be hidden,
so if you have, say, a logging core plugin, it won't have to show up,
but then you load the GTK+ logging plugin and it'll auto-load the core
plugin. Core/UI split plugins!
5) There will eventually be custom plugin signals and RPC of some sort, for
the core/ui split plugins.
So, okay, back up .gaimrc.
I'd like to thank my parents for their support, javabsp for helping convert
a bunch of protocol plugins, and Etan for helping convert a bunch of
standard plugins.
Have fun. If you have any problems, please let me know, but you probably
won't have anything major happen. You will have to convert your plugins,
though, and I'm not guaranteeing that all perl scripts will still work.
I'll end up changing the perl script API eventually, so I know they won't
down the road. Don't worry, though. It'll be mass cool.
faceprint wants me to just commit the damn code already. So, here we go!!!
..
..
I need a massage. From a young, cute girl. Are there any young, cute girls
in the audience? IM me plz k thx.
committer: Tailor Script <tailor@pidgin.im>
author | Christian Hammond <chipx86@chipx86.com> |
---|---|
date | Fri, 25 Apr 2003 06:47:33 +0000 |
parents | |
children | 6d1707dc8c3d |
comparison
equal
deleted
inserted
replaced
5204:44de70702205 | 5205:fefad67de2c7 |
---|---|
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)) { | |
273 debug_printf("Perl function %s exited abnormally: %s\n", | |
274 function, SvPV(ERRSV, na)); | |
275 POPs; | |
276 } | |
277 else if (count != 1) { | |
278 /* | |
279 * This should NEVER happen. G_SCALAR ensures that we WILL | |
280 * have 1 parameter. | |
281 */ | |
282 debug_printf("Perl error from %s: expected 1 return value, " | |
283 "but got %d\n", function, count); | |
284 } | |
285 else | |
286 ret_value = POPi; | |
287 | |
288 /* Check for changed arguments */ | |
289 for (i = 0; i < argc; i++) { | |
290 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { | |
291 /* | |
292 * Shizzel. So the perl script changed one of the parameters, | |
293 * and we want this change to affect the original parameters. | |
294 * args[i] is just a tempory little list of pointers. We don't | |
295 * want to free args[i] here because the new parameter doesn't | |
296 * overwrite the data that args[i] points to. That is done by | |
297 * the function that called execute_perl. I'm not explaining this | |
298 * very well. See, it's aggregate... Oh, but if 2 perl scripts | |
299 * both modify the data, _that's_ a memleak. This is really kind | |
300 * of hackish. I should fix it. Look how long this comment is. | |
301 * Holy crap. | |
302 */ | |
303 args[i] = g_strdup(SvPV(sv_args[i], na)); | |
304 } | |
305 } | |
306 | |
307 PUTBACK; | |
308 FREETMPS; | |
309 LEAVE; | |
310 | |
311 return ret_value; | |
312 } | |
313 | |
314 static void | |
315 perl_unload_file(GaimPlugin *plug) | |
316 { | |
317 char *atmp[2] = { "", NULL }; | |
318 struct perlscript *scp = NULL; | |
319 struct _perl_timeout_handlers *thn; | |
320 struct _perl_event_handlers *ehn; | |
321 GList *pl; | |
322 | |
323 for (pl = perl_list; pl != NULL; pl = pl->next) { | |
324 scp = pl->data; | |
325 | |
326 if (scp->plug == plug) { | |
327 perl_list = g_list_remove(perl_list, scp); | |
328 | |
329 if (scp->shutdowncallback[0]) | |
330 execute_perl(scp->shutdowncallback, 1, atmp); | |
331 | |
332 g_free(scp->name); | |
333 g_free(scp->version); | |
334 g_free(scp->shutdowncallback); | |
335 g_free(scp); | |
336 | |
337 break; | |
338 } | |
339 } | |
340 | |
341 for (pl = perl_timeout_handlers; pl != NULL; pl = pl->next) { | |
342 thn = pl->data; | |
343 | |
344 if (thn && thn->plug == plug) { | |
345 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn); | |
346 | |
347 g_source_remove(thn->iotag); | |
348 g_free(thn->handler_args); | |
349 g_free(thn->handler_name); | |
350 g_free(thn); | |
351 } | |
352 } | |
353 | |
354 for (pl = perl_event_handlers; pl != NULL; pl = pl->next) { | |
355 ehn = pl->data; | |
356 | |
357 if (ehn && ehn->plug == plug) { | |
358 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
359 | |
360 g_free(ehn->event_type); | |
361 g_free(ehn->handler_name); | |
362 g_free(ehn); | |
363 } | |
364 } | |
365 } | |
366 | |
367 static int | |
368 perl_load_file(char *script_name, GaimPlugin *plugin) | |
369 { | |
370 char *atmp[2] = { script_name, NULL }; | |
371 GList *s; | |
372 struct perlscript *scp; | |
373 int ret; | |
374 | |
375 if (my_perl == NULL) | |
376 perl_init(); | |
377 | |
378 plugin->handle = plugin->path; | |
379 | |
380 ret = execute_perl("load_n_eval", 1, atmp); | |
381 | |
382 for (s = perl_list; s != NULL; s = s->next) { | |
383 scp = s->data; | |
384 | |
385 if (!strcmp(scp->name, plugin->info->name) && | |
386 !strcmp(scp->version, plugin->info->version)) { | |
387 | |
388 break; | |
389 } | |
390 } | |
391 | |
392 if (!s) { | |
393 plugin->error = g_strdup(_("GAIM::register not called with " | |
394 "proper arguments. Consult PERL-HOWTO.")); | |
395 | |
396 return 0; | |
397 } | |
398 | |
399 return ret; | |
400 } | |
401 | |
402 static void | |
403 perl_init(void) | |
404 { | |
405 /* changed the name of the variable from load_file to | |
406 perl_definitions since now it does much more than defining | |
407 the load_file sub. Moreover, deplaced the initialisation to | |
408 the xs_init function. (TheHobbit)*/ | |
409 char *perl_args[] = { "", "-e", "0", "-w" }; | |
410 char perl_definitions[] = | |
411 { | |
412 /* We use to function one to load a file the other to | |
413 execute the string obtained from the first and holding | |
414 the file conents. This allows to have a realy local $/ | |
415 without introducing temp variables to hold the old | |
416 value. Just a question of style:) */ | |
417 "sub load_file{" | |
418 "my $f_name=shift;" | |
419 "local $/=undef;" | |
420 "open FH,$f_name or return \"__FAILED__\";" | |
421 "$_=<FH>;" | |
422 "close FH;" | |
423 "return $_;" | |
424 "}" | |
425 "sub load_n_eval{" | |
426 "my $f_name=shift;" | |
427 "my $strin=load_file($f_name);" | |
428 "return 2 if($strin eq \"__FAILED__\");" | |
429 "eval $strin;" | |
430 "if($@){" | |
431 /*" #something went wrong\n"*/ | |
432 "GAIM::print(\"Errors loading file $f_name:\\n\",\"$@\");" | |
433 "return 1;" | |
434 "}" | |
435 "return 0;" | |
436 "}" | |
437 }; | |
438 | |
439 my_perl = perl_alloc(); | |
440 perl_construct(my_perl); | |
441 #ifdef DEBUG | |
442 perl_parse(my_perl, xs_init, 4, perl_args, NULL); | |
443 #else | |
444 perl_parse(my_perl, xs_init, 3, perl_args, NULL); | |
445 #endif | |
446 #ifdef HAVE_PERL_EVAL_PV | |
447 eval_pv(perl_definitions, TRUE); | |
448 #else | |
449 perl_eval_pv(perl_definitions, TRUE); /* deprecated */ | |
450 #endif | |
451 } | |
452 | |
453 static void | |
454 perl_end(void) | |
455 { | |
456 char *atmp[2] = { "", NULL }; | |
457 struct perlscript *scp; | |
458 struct _perl_timeout_handlers *thn; | |
459 struct _perl_event_handlers *ehn; | |
460 | |
461 while (perl_list) { | |
462 scp = perl_list->data; | |
463 perl_list = g_list_remove(perl_list, scp); | |
464 | |
465 if (scp->shutdowncallback[0]) | |
466 execute_perl(scp->shutdowncallback, 1, atmp); | |
467 | |
468 g_free(scp->name); | |
469 g_free(scp->version); | |
470 g_free(scp->shutdowncallback); | |
471 g_free(scp); | |
472 } | |
473 | |
474 while (perl_timeout_handlers) { | |
475 thn = perl_timeout_handlers->data; | |
476 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn); | |
477 g_source_remove(thn->iotag); | |
478 g_free(thn->handler_args); | |
479 g_free(thn->handler_name); | |
480 g_free(thn); | |
481 } | |
482 | |
483 while (perl_event_handlers) { | |
484 ehn = perl_event_handlers->data; | |
485 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
486 g_free(ehn->event_type); | |
487 g_free(ehn->handler_name); | |
488 g_free(ehn); | |
489 } | |
490 | |
491 if (my_perl != NULL) { | |
492 perl_destruct(my_perl); | |
493 perl_free(my_perl); | |
494 my_perl = NULL; | |
495 } | |
496 } | |
497 | |
498 XS (XS_GAIM_register) | |
499 { | |
500 char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */ | |
501 unsigned int junk; | |
502 struct perlscript *scp; | |
503 GaimPlugin *plug = NULL; | |
504 GList *pl; | |
505 | |
506 dXSARGS; | |
507 items = 0; | |
508 | |
509 name = SvPV(ST(0), junk); | |
510 ver = SvPV(ST(1), junk); | |
511 callback = SvPV(ST(2), junk); | |
512 unused = SvPV(ST(3), junk); | |
513 | |
514 debug_printf("GAIM::register(%s, %s)\n", name, ver); | |
515 | |
516 for (pl = gaim_plugins_get_all(); pl != NULL; pl = pl->next) { | |
517 plug = pl->data; | |
518 | |
519 debug_printf("** Comparing '%s' to '%s' and '%s' to '%s'\n", | |
520 name, plug->info->name, ver, | |
521 plug->info->version); | |
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); | |
662 do_error_dialog(title, message, GAIM_INFO); | |
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) { | |
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: | |
1053 debug_printf("someone forgot to handle %s in the perl binding\n", | |
1054 gaim_event_get_name(event)); | |
1055 return 0; | |
1056 } | |
1057 | |
1058 /* Call any applicable functions */ | |
1059 for (handler = perl_event_handlers; | |
1060 handler != NULL; | |
1061 handler = handler->next) { | |
1062 | |
1063 data = handler->data; | |
1064 | |
1065 if (!strcmp(gaim_event_get_name(event), data->event_type)) { | |
1066 | |
1067 handler_return = execute_perl(data->handler_name, 5, buf); | |
1068 | |
1069 if (handler_return) | |
1070 return handler_return; | |
1071 } | |
1072 } | |
1073 | |
1074 /* Now make changes from perl scripts affect the real data */ | |
1075 switch (event) { | |
1076 case event_im_recv: | |
1077 if (buf[1] != *(char **)arg2) { | |
1078 free(*(char **)arg2); | |
1079 *(char **)arg2 = buf[1]; | |
1080 } | |
1081 if (buf[2] != *(char **)arg3) { | |
1082 free(*(char **)arg3); | |
1083 *(char **)arg3 = buf[2]; | |
1084 } | |
1085 break; | |
1086 case event_im_send: | |
1087 if (buf[2] != *(char **)arg3) { | |
1088 free(*(char **)arg3); | |
1089 *(char **)arg3 = buf[2]; | |
1090 } | |
1091 break; | |
1092 case event_chat_recv: | |
1093 if (buf[2] != *(char **)arg3) { | |
1094 free(*(char **)arg3); | |
1095 *(char **)arg3 = buf[2]; | |
1096 } | |
1097 if (buf[3] != *(char **)arg4) { | |
1098 free(*(char **)arg4); | |
1099 *(char **)arg4 = buf[3]; | |
1100 } | |
1101 break; | |
1102 case event_chat_send_invite: | |
1103 if (buf[3] != *(char **)arg4) { | |
1104 free(*(char **)arg4); | |
1105 *(char **)arg4 = buf[3]; | |
1106 } | |
1107 break; | |
1108 case event_chat_send: | |
1109 if (buf[2] != *(char **)arg3) { | |
1110 free(*(char **)arg3); | |
1111 *(char **)arg3 = buf[2]; | |
1112 } | |
1113 break; | |
1114 case event_im_displayed_sent: | |
1115 if (buf[2] != *(char **)arg3) { | |
1116 free(*(char **)arg3); | |
1117 *(char **)arg3 = buf[2]; | |
1118 } | |
1119 break; | |
1120 default: | |
1121 break; | |
1122 } | |
1123 | |
1124 return 0; | |
1125 } | |
1126 | |
1127 XS (XS_GAIM_add_event_handler) | |
1128 { | |
1129 unsigned int junk; | |
1130 struct _perl_event_handlers *handler; | |
1131 char *handle; | |
1132 GaimPlugin *plug; | |
1133 GList *p; | |
1134 dXSARGS; | |
1135 items = 0; | |
1136 | |
1137 handle = SvPV(ST(0), junk); | |
1138 | |
1139 for (p = gaim_plugins_get_all(); p != NULL; p = p->next) { | |
1140 plug = p->data; | |
1141 | |
1142 if (!strcmp(handle, plug->path)) | |
1143 break; | |
1144 } | |
1145 | |
1146 if (p) { | |
1147 handler = g_new0(struct _perl_event_handlers, 1); | |
1148 handler->event_type = g_strdup(SvPV(ST(1), junk)); | |
1149 handler->handler_name = g_strdup(SvPV(ST(2), junk)); | |
1150 handler->plug = plug; | |
1151 perl_event_handlers = g_list_append(perl_event_handlers, handler); | |
1152 debug_printf("registered perl event handler for %s\n", handler->event_type); | |
1153 } else { | |
1154 debug_printf("Invalid handle (%s) registering perl event handler\n", handle); | |
1155 } | |
1156 | |
1157 XSRETURN_EMPTY; | |
1158 } | |
1159 | |
1160 XS (XS_GAIM_remove_event_handler) | |
1161 { | |
1162 unsigned int junk; | |
1163 struct _perl_event_handlers *ehn; | |
1164 GList *cur = perl_event_handlers; | |
1165 dXSARGS; | |
1166 items = 0; | |
1167 | |
1168 while (cur) { | |
1169 GList *next = cur->next; | |
1170 ehn = cur->data; | |
1171 | |
1172 if (!strcmp(ehn->event_type, SvPV(ST(0), junk)) && | |
1173 !strcmp(ehn->handler_name, SvPV(ST(1), junk))) | |
1174 { | |
1175 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); | |
1176 g_free(ehn->event_type); | |
1177 g_free(ehn->handler_name); | |
1178 g_free(ehn); | |
1179 } | |
1180 | |
1181 cur = next; | |
1182 } | |
1183 } | |
1184 | |
1185 static int | |
1186 perl_timeout(gpointer data) | |
1187 { | |
1188 char *atmp[2] = { NULL, NULL }; | |
1189 struct _perl_timeout_handlers *handler = data; | |
1190 | |
1191 atmp[0] = escape_quotes(handler->handler_args); | |
1192 execute_perl(handler->handler_name, 1, atmp); | |
1193 | |
1194 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler); | |
1195 g_free(handler->handler_args); | |
1196 g_free(handler->handler_name); | |
1197 g_free(handler); | |
1198 | |
1199 return 0; /* returning zero removes the timeout handler */ | |
1200 } | |
1201 | |
1202 XS (XS_GAIM_add_timeout_handler) | |
1203 { | |
1204 unsigned int junk; | |
1205 long timeout; | |
1206 struct _perl_timeout_handlers *handler; | |
1207 char *handle; | |
1208 GaimPlugin *plug; | |
1209 GList *p; | |
1210 | |
1211 dXSARGS; | |
1212 items = 0; | |
1213 | |
1214 handle = SvPV(ST(0), junk); | |
1215 | |
1216 for (p = gaim_plugins_get_all(); p != NULL; p = p->next) { | |
1217 plug = p->data; | |
1218 | |
1219 if (!strcmp(handle, plug->path)) | |
1220 break; | |
1221 } | |
1222 | |
1223 if (p) { | |
1224 handler = g_new0(struct _perl_timeout_handlers, 1); | |
1225 timeout = 1000 * SvIV(ST(1)); | |
1226 debug_printf("Adding timeout for %ld seconds.\n", timeout/1000); | |
1227 handler->plug = plug; | |
1228 handler->handler_name = g_strdup(SvPV(ST(2), junk)); | |
1229 handler->handler_args = g_strdup(SvPV(ST(3), junk)); | |
1230 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler); | |
1231 handler->iotag = g_timeout_add(timeout, perl_timeout, handler); | |
1232 } else { | |
1233 debug_printf("Invalid handle (%s) in adding perl timeout handler.", handle); | |
1234 } | |
1235 XSRETURN_EMPTY; | |
1236 } | |
1237 | |
1238 XS (XS_GAIM_play_sound) | |
1239 { | |
1240 int id; | |
1241 dXSARGS; | |
1242 | |
1243 items = 0; | |
1244 | |
1245 id = SvIV(ST(0)); | |
1246 | |
1247 gaim_sound_play_event(id); | |
1248 | |
1249 XSRETURN_EMPTY; | |
1250 } | |
1251 | |
1252 static gboolean | |
1253 probe_perl_plugin(GaimPlugin *plugin) | |
1254 { | |
1255 /* XXX This would be much faster if I didn't create a new | |
1256 * PerlInterpreter every time I probed a plugin */ | |
1257 | |
1258 GaimPluginInfo *info; | |
1259 PerlInterpreter *prober = perl_alloc(); | |
1260 char *argv[] = {"", plugin->path }; | |
1261 int count; | |
1262 gboolean status = TRUE; | |
1263 | |
1264 perl_construct(prober); | |
1265 perl_parse(prober, NULL, 2, argv, NULL); | |
1266 | |
1267 { | |
1268 dSP; | |
1269 ENTER; | |
1270 SAVETMPS; | |
1271 PUSHMARK(SP); | |
1272 | |
1273 count = perl_call_pv("description", G_NOARGS | G_ARRAY | G_EVAL); | |
1274 SPAGAIN; | |
1275 | |
1276 if (count == 6) { | |
1277 info = g_new0(GaimPluginInfo, 1); | |
1278 | |
1279 info->api_version = 2; | |
1280 info->type = GAIM_PLUGIN_STANDARD; | |
1281 | |
1282 info->dependencies = g_list_append(info->dependencies, | |
1283 PERL_PLUGIN_ID); | |
1284 | |
1285 POPp; /* iconfile */ | |
1286 | |
1287 info->homepage = g_strdup(POPp); | |
1288 info->author = g_strdup(POPp); | |
1289 info->description = g_strdup(POPp); | |
1290 info->version = g_strdup(POPp); | |
1291 info->name = g_strdup(POPp); | |
1292 | |
1293 plugin->info = info; | |
1294 | |
1295 if (!gaim_plugin_register(plugin)) | |
1296 status = FALSE; | |
1297 } | |
1298 else | |
1299 status = FALSE; | |
1300 | |
1301 PUTBACK; | |
1302 FREETMPS; | |
1303 LEAVE; | |
1304 } | |
1305 | |
1306 perl_destruct(prober); | |
1307 perl_free(prober); | |
1308 | |
1309 return status; | |
1310 } | |
1311 | |
1312 static gboolean | |
1313 load_perl_plugin(GaimPlugin *plugin) | |
1314 { | |
1315 perl_load_file(plugin->path, plugin); | |
1316 | |
1317 return TRUE; | |
1318 } | |
1319 | |
1320 static gboolean | |
1321 unload_perl_plugin(GaimPlugin *plugin) | |
1322 { | |
1323 perl_unload_file(plugin); | |
1324 | |
1325 return TRUE; | |
1326 } | |
1327 | |
1328 static void | |
1329 destroy_perl_plugin(GaimPlugin *plugin) | |
1330 { | |
1331 if (plugin->info != NULL) { | |
1332 g_free(plugin->info->name); | |
1333 g_free(plugin->info->version); | |
1334 g_free(plugin->info->description); | |
1335 g_free(plugin->info->author); | |
1336 g_free(plugin->info->homepage); | |
1337 } | |
1338 } | |
1339 | |
1340 static gboolean | |
1341 plugin_unload(GaimPlugin *plugin) | |
1342 { | |
1343 perl_end(); | |
1344 | |
1345 return TRUE; | |
1346 } | |
1347 | |
1348 static GaimPluginLoaderInfo loader_info = | |
1349 { | |
1350 NULL, /**< exts */ | |
1351 | |
1352 probe_perl_plugin, /**< probe */ | |
1353 load_perl_plugin, /**< load */ | |
1354 unload_perl_plugin, /**< unload */ | |
1355 destroy_perl_plugin, /**< destroy */ | |
1356 perl_event /**< broadcast */ | |
1357 }; | |
1358 | |
1359 static GaimPluginInfo info = | |
1360 { | |
1361 2, /**< api_version */ | |
1362 GAIM_PLUGIN_LOADER, /**< type */ | |
1363 NULL, /**< ui_requirement */ | |
1364 0, /**< flags */ | |
1365 NULL, /**< dependencies */ | |
1366 GAIM_PRIORITY_DEFAULT, /**< priority */ | |
1367 | |
1368 PERL_PLUGIN_ID, /**< id */ | |
1369 N_("Perl Plugin Loader"), /**< name */ | |
1370 VERSION, /**< version */ | |
1371 N_("Provides support for loading perl plugins."), /**< summary */ | |
1372 N_("Provides support for loading perl plugins."), /**< description */ | |
1373 "Christian Hammond <chipx86@gnupdate.org>", /**< author */ | |
1374 WEBSITE, /**< homepage */ | |
1375 | |
1376 NULL, /**< load */ | |
1377 plugin_unload, /**< unload */ | |
1378 NULL, /**< destroy */ | |
1379 | |
1380 NULL, /**< ui_info */ | |
1381 &loader_info /**< extra_info */ | |
1382 }; | |
1383 | |
1384 static void | |
1385 __init_plugin(GaimPlugin *plugin) | |
1386 { | |
1387 loader_info.exts = g_list_append(loader_info.exts, "pl"); | |
1388 } | |
1389 | |
1390 GAIM_INIT_PLUGIN(perl, __init_plugin, info); |