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