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