Mercurial > pidgin
comparison libpurple/plugins/perl/perl-handlers.c @ 15373:5fe8042783c1
Rename gtk/ and libgaim/ to pidgin/ and libpurple/
author | Sean Egan <seanegan@gmail.com> |
---|---|
date | Sat, 20 Jan 2007 02:32:10 +0000 |
parents | |
children | 32c366eeeb99 |
comparison
equal
deleted
inserted
replaced
15372:f79e0f4df793 | 15373:5fe8042783c1 |
---|---|
1 #include "perl-common.h" | |
2 #include "perl-handlers.h" | |
3 | |
4 #include "debug.h" | |
5 #include "signals.h" | |
6 | |
7 extern PerlInterpreter *my_perl; | |
8 static GList *cmd_handlers = NULL; | |
9 static GList *signal_handlers = NULL; | |
10 static GList *timeout_handlers = NULL; | |
11 | |
12 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ | |
13 #ifndef PERL_MAGIC_ext | |
14 #define PERL_MAGIC_ext '~' | |
15 #endif | |
16 | |
17 void | |
18 gaim_perl_plugin_action_cb(GaimPluginAction *action) | |
19 { | |
20 SV **callback; | |
21 HV *hv = NULL; | |
22 gchar *hvname; | |
23 GaimPlugin *plugin; | |
24 GaimPerlScript *gps; | |
25 dSP; | |
26 | |
27 plugin = action->plugin; | |
28 gps = (GaimPerlScript *)plugin->info->extra_info; | |
29 hvname = g_strdup_printf("%s::plugin_actions", gps->package); | |
30 hv = get_hv(hvname, FALSE); | |
31 g_free(hvname); | |
32 | |
33 if (hv == NULL) | |
34 croak("No plugin_actions hash found in \"%s\" plugin.", gaim_plugin_get_name(plugin)); | |
35 | |
36 ENTER; | |
37 SAVETMPS; | |
38 | |
39 callback = hv_fetch(hv, action->label, strlen(action->label), 0); | |
40 | |
41 if (callback == NULL || *callback == NULL) | |
42 croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, gaim_plugin_get_name(plugin)); | |
43 | |
44 PUSHMARK(sp); | |
45 XPUSHs(gaim_perl_bless_object(gps->plugin, "Gaim::Plugin")); | |
46 PUTBACK; | |
47 | |
48 call_sv(*callback, G_VOID | G_DISCARD); | |
49 SPAGAIN; | |
50 | |
51 PUTBACK; | |
52 FREETMPS; | |
53 LEAVE; | |
54 } | |
55 | |
56 GList * | |
57 gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context) | |
58 { | |
59 GList *l = NULL; | |
60 GaimPerlScript *gps; | |
61 int i = 0, count = 0; | |
62 dSP; | |
63 | |
64 gps = (GaimPerlScript *)plugin->info->extra_info; | |
65 | |
66 ENTER; | |
67 SAVETMPS; | |
68 | |
69 PUSHMARK(SP); | |
70 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin"))); | |
71 /* XXX This *will* cease working correctly if context gets changed to | |
72 * ever be able to hold anything other than a GaimConnection */ | |
73 if (context != NULL) | |
74 XPUSHs(sv_2mortal(gaim_perl_bless_object(context, | |
75 "Gaim::Connection"))); | |
76 else | |
77 XPUSHs(&PL_sv_undef); | |
78 PUTBACK; | |
79 | |
80 count = call_pv(gps->plugin_action_sub, G_ARRAY); | |
81 | |
82 SPAGAIN; | |
83 | |
84 if (count == 0) | |
85 croak("The plugin_actions sub didn't return anything.\n"); | |
86 | |
87 for (i = 0; i < count; i++) { | |
88 SV *sv; | |
89 gchar *label; | |
90 GaimPluginAction *act = NULL; | |
91 | |
92 sv = POPs; | |
93 label = SvPV_nolen(sv); | |
94 /* XXX I think this leaks, but doing it without the strdup | |
95 * just showed garbage */ | |
96 act = gaim_plugin_action_new(g_strdup(label), gaim_perl_plugin_action_cb); | |
97 l = g_list_prepend(l, act); | |
98 } | |
99 | |
100 PUTBACK; | |
101 FREETMPS; | |
102 LEAVE; | |
103 | |
104 return l; | |
105 } | |
106 | |
107 #ifdef GAIM_GTKPERL | |
108 GtkWidget * | |
109 gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) | |
110 { | |
111 SV * sv; | |
112 int count; | |
113 MAGIC *mg; | |
114 GtkWidget *ret; | |
115 GaimPerlScript *gps; | |
116 dSP; | |
117 | |
118 gps = (GaimPerlScript *)plugin->info->extra_info; | |
119 | |
120 ENTER; | |
121 SAVETMPS; | |
122 | |
123 count = call_pv(gps->gtk_prefs_sub, G_SCALAR | G_NOARGS); | |
124 if (count != 1) | |
125 croak("call_pv: Did not return the correct number of values.\n"); | |
126 | |
127 /* the frame was created in a perl sub and is returned */ | |
128 SPAGAIN; | |
129 | |
130 /* We have a Gtk2::Frame on top of the stack */ | |
131 sv = POPs; | |
132 | |
133 /* The magic field hides the pointer to the actual GtkWidget */ | |
134 mg = mg_find(SvRV(sv), PERL_MAGIC_ext); | |
135 ret = (GtkWidget *)mg->mg_ptr; | |
136 | |
137 PUTBACK; | |
138 FREETMPS; | |
139 LEAVE; | |
140 | |
141 return ret; | |
142 } | |
143 #endif | |
144 | |
145 GaimPluginPrefFrame * | |
146 gaim_perl_get_plugin_frame(GaimPlugin *plugin) | |
147 { | |
148 /* Sets up the Perl Stack for our call back into the script to run the | |
149 * plugin_pref... sub */ | |
150 int count; | |
151 GaimPerlScript *gps; | |
152 GaimPluginPrefFrame *ret_frame; | |
153 dSP; | |
154 | |
155 gps = (GaimPerlScript *)plugin->info->extra_info; | |
156 | |
157 ENTER; | |
158 SAVETMPS; | |
159 /* Some perl magic to run perl_plugin_pref_frame_SV perl sub and | |
160 * return the frame */ | |
161 PUSHMARK(SP); | |
162 PUTBACK; | |
163 | |
164 count = call_pv(gps->prefs_sub, G_SCALAR | G_NOARGS); | |
165 | |
166 SPAGAIN; | |
167 | |
168 if (count != 1) | |
169 croak("call_pv: Did not return the correct number of values.\n"); | |
170 /* the frame was created in a perl sub and is returned */ | |
171 ret_frame = (GaimPluginPrefFrame *)gaim_perl_ref_object(POPs); | |
172 | |
173 /* Tidy up the Perl stack */ | |
174 PUTBACK; | |
175 FREETMPS; | |
176 LEAVE; | |
177 | |
178 return ret_frame; | |
179 } | |
180 | |
181 static void | |
182 destroy_timeout_handler(GaimPerlTimeoutHandler *handler) | |
183 { | |
184 timeout_handlers = g_list_remove(timeout_handlers, handler); | |
185 | |
186 if (handler->callback != NULL) | |
187 SvREFCNT_dec(handler->callback); | |
188 | |
189 if (handler->data != NULL) | |
190 SvREFCNT_dec(handler->data); | |
191 | |
192 g_free(handler); | |
193 } | |
194 | |
195 static void | |
196 destroy_signal_handler(GaimPerlSignalHandler *handler) | |
197 { | |
198 signal_handlers = g_list_remove(signal_handlers, handler); | |
199 | |
200 if (handler->callback != NULL) | |
201 SvREFCNT_dec(handler->callback); | |
202 | |
203 if (handler->data != NULL) | |
204 SvREFCNT_dec(handler->data); | |
205 | |
206 g_free(handler->signal); | |
207 g_free(handler); | |
208 } | |
209 | |
210 static int | |
211 perl_timeout_cb(gpointer data) | |
212 { | |
213 GaimPerlTimeoutHandler *handler = (GaimPerlTimeoutHandler *)data; | |
214 | |
215 dSP; | |
216 ENTER; | |
217 SAVETMPS; | |
218 PUSHMARK(sp); | |
219 XPUSHs((SV *)handler->data); | |
220 PUTBACK; | |
221 call_sv(handler->callback, G_EVAL | G_SCALAR); | |
222 SPAGAIN; | |
223 | |
224 PUTBACK; | |
225 FREETMPS; | |
226 LEAVE; | |
227 | |
228 destroy_timeout_handler(handler); | |
229 | |
230 return 0; | |
231 } | |
232 | |
233 typedef void *DATATYPE; | |
234 | |
235 static void * | |
236 perl_signal_cb(va_list args, void *data) | |
237 { | |
238 GaimPerlSignalHandler *handler = (GaimPerlSignalHandler *)data; | |
239 void *ret_val = NULL; | |
240 int i; | |
241 int count; | |
242 int value_count; | |
243 GaimValue *ret_value, **values; | |
244 SV **sv_args; | |
245 DATATYPE **copy_args; | |
246 STRLEN na; | |
247 | |
248 dSP; | |
249 ENTER; | |
250 SAVETMPS; | |
251 PUSHMARK(sp); | |
252 | |
253 gaim_signal_get_values(handler->instance, handler->signal, | |
254 &ret_value, &value_count, &values); | |
255 | |
256 sv_args = g_new(SV *, value_count); | |
257 copy_args = g_new(void **, value_count); | |
258 | |
259 for (i = 0; i < value_count; i++) { | |
260 sv_args[i] = gaim_perl_sv_from_vargs(values[i], | |
261 (va_list*)&args, | |
262 ©_args[i]); | |
263 | |
264 XPUSHs(sv_args[i]); | |
265 } | |
266 | |
267 XPUSHs((SV *)handler->data); | |
268 | |
269 PUTBACK; | |
270 | |
271 if (ret_value != NULL) { | |
272 count = call_sv(handler->callback, G_EVAL | G_SCALAR); | |
273 | |
274 SPAGAIN; | |
275 | |
276 if (count != 1) | |
277 croak("Uh oh! call_sv returned %i != 1", i); | |
278 else | |
279 ret_val = gaim_perl_data_from_sv(ret_value, POPs); | |
280 } else { | |
281 call_sv(handler->callback, G_SCALAR); | |
282 | |
283 SPAGAIN; | |
284 } | |
285 | |
286 if (SvTRUE(ERRSV)) { | |
287 gaim_debug_error("perl", | |
288 "Perl function exited abnormally: %s\n", | |
289 SvPV(ERRSV, na)); | |
290 } | |
291 | |
292 /* See if any parameters changed. */ | |
293 for (i = 0; i < value_count; i++) { | |
294 if (gaim_value_is_outgoing(values[i])) { | |
295 switch (gaim_value_get_type(values[i])) { | |
296 case GAIM_TYPE_BOOLEAN: | |
297 *((gboolean *)copy_args[i]) = SvIV(sv_args[i]); | |
298 break; | |
299 | |
300 case GAIM_TYPE_INT: | |
301 *((int *)copy_args[i]) = SvIV(sv_args[i]); | |
302 break; | |
303 | |
304 case GAIM_TYPE_UINT: | |
305 *((unsigned int *)copy_args[i]) = SvUV(sv_args[i]); | |
306 break; | |
307 | |
308 case GAIM_TYPE_LONG: | |
309 *((long *)copy_args[i]) = SvIV(sv_args[i]); | |
310 break; | |
311 | |
312 case GAIM_TYPE_ULONG: | |
313 *((unsigned long *)copy_args[i]) = SvUV(sv_args[i]); | |
314 break; | |
315 | |
316 case GAIM_TYPE_INT64: | |
317 *((gint64 *)copy_args[i]) = SvIV(sv_args[i]); | |
318 break; | |
319 | |
320 case GAIM_TYPE_UINT64: | |
321 *((guint64 *)copy_args[i]) = SvUV(sv_args[i]); | |
322 break; | |
323 | |
324 case GAIM_TYPE_STRING: | |
325 if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) { | |
326 g_free(*((char **)copy_args[i])); | |
327 *((char **)copy_args[i]) = | |
328 g_strdup(SvPV(sv_args[i], na)); | |
329 } | |
330 break; | |
331 | |
332 case GAIM_TYPE_POINTER: | |
333 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); | |
334 break; | |
335 | |
336 case GAIM_TYPE_BOXED: | |
337 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); | |
338 break; | |
339 | |
340 default: | |
341 break; | |
342 } | |
343 | |
344 #if 0 | |
345 *((void **)copy_args[i]) = gaim_perl_data_from_sv(values[i], | |
346 sv_args[i]); | |
347 #endif | |
348 } | |
349 } | |
350 | |
351 PUTBACK; | |
352 FREETMPS; | |
353 LEAVE; | |
354 | |
355 g_free(sv_args); | |
356 g_free(copy_args); | |
357 | |
358 gaim_debug_misc("perl", "ret_val = %p\n", ret_val); | |
359 | |
360 return ret_val; | |
361 } | |
362 | |
363 static GaimPerlSignalHandler * | |
364 find_signal_handler(GaimPlugin *plugin, void *instance, const char *signal) | |
365 { | |
366 GaimPerlSignalHandler *handler; | |
367 GList *l; | |
368 | |
369 for (l = signal_handlers; l != NULL; l = l->next) { | |
370 handler = (GaimPerlSignalHandler *)l->data; | |
371 | |
372 if (handler->plugin == plugin && | |
373 handler->instance == instance && | |
374 !strcmp(handler->signal, signal)) { | |
375 return handler; | |
376 } | |
377 } | |
378 | |
379 return NULL; | |
380 } | |
381 | |
382 void | |
383 gaim_perl_timeout_add(GaimPlugin *plugin, int seconds, SV *callback, SV *data) | |
384 { | |
385 GaimPerlTimeoutHandler *handler; | |
386 | |
387 if (plugin == NULL) { | |
388 croak("Invalid handle in adding perl timeout handler.\n"); | |
389 return; | |
390 } | |
391 | |
392 handler = g_new0(GaimPerlTimeoutHandler, 1); | |
393 | |
394 handler->plugin = plugin; | |
395 handler->callback = (callback != NULL && callback != &PL_sv_undef | |
396 ? newSVsv(callback) : NULL); | |
397 handler->data = (data != NULL && data != &PL_sv_undef | |
398 ? newSVsv(data) : NULL); | |
399 | |
400 timeout_handlers = g_list_append(timeout_handlers, handler); | |
401 | |
402 handler->iotag = g_timeout_add(seconds * 1000, perl_timeout_cb, handler); | |
403 } | |
404 | |
405 void | |
406 gaim_perl_timeout_clear_for_plugin(GaimPlugin *plugin) | |
407 { | |
408 GaimPerlTimeoutHandler *handler; | |
409 GList *l, *l_next; | |
410 | |
411 for (l = timeout_handlers; l != NULL; l = l_next) { | |
412 l_next = l->next; | |
413 | |
414 handler = (GaimPerlTimeoutHandler *)l->data; | |
415 | |
416 if (handler->plugin == plugin) | |
417 destroy_timeout_handler(handler); | |
418 } | |
419 } | |
420 | |
421 void | |
422 gaim_perl_timeout_clear(void) | |
423 { | |
424 while (timeout_handlers != NULL) | |
425 destroy_timeout_handler(timeout_handlers->data); | |
426 } | |
427 | |
428 void | |
429 gaim_perl_signal_connect(GaimPlugin *plugin, void *instance, | |
430 const char *signal, SV *callback, SV *data, | |
431 int priority) | |
432 { | |
433 GaimPerlSignalHandler *handler; | |
434 | |
435 handler = g_new0(GaimPerlSignalHandler, 1); | |
436 handler->plugin = plugin; | |
437 handler->instance = instance; | |
438 handler->signal = g_strdup(signal); | |
439 handler->callback = (callback != NULL && | |
440 callback != &PL_sv_undef ? newSVsv(callback) | |
441 : NULL); | |
442 handler->data = (data != NULL && | |
443 data != &PL_sv_undef ? newSVsv(data) : NULL); | |
444 | |
445 signal_handlers = g_list_append(signal_handlers, handler); | |
446 | |
447 gaim_signal_connect_priority_vargs(instance, signal, plugin, | |
448 GAIM_CALLBACK(perl_signal_cb), | |
449 handler, priority); | |
450 } | |
451 | |
452 void | |
453 gaim_perl_signal_disconnect(GaimPlugin *plugin, void *instance, | |
454 const char *signal) | |
455 { | |
456 GaimPerlSignalHandler *handler; | |
457 | |
458 handler = find_signal_handler(plugin, instance, signal); | |
459 | |
460 if (handler == NULL) { | |
461 croak("Invalid signal handler information in " | |
462 "disconnecting a perl signal handler.\n"); | |
463 return; | |
464 } | |
465 | |
466 destroy_signal_handler(handler); | |
467 } | |
468 | |
469 void | |
470 gaim_perl_signal_clear_for_plugin(GaimPlugin *plugin) | |
471 { | |
472 GaimPerlSignalHandler *handler; | |
473 GList *l, *l_next; | |
474 | |
475 for (l = signal_handlers; l != NULL; l = l_next) { | |
476 l_next = l->next; | |
477 | |
478 handler = (GaimPerlSignalHandler *)l->data; | |
479 | |
480 if (handler->plugin == plugin) | |
481 destroy_signal_handler(handler); | |
482 } | |
483 } | |
484 | |
485 void | |
486 gaim_perl_signal_clear(void) | |
487 { | |
488 while (signal_handlers != NULL) | |
489 destroy_signal_handler(signal_handlers->data); | |
490 } | |
491 | |
492 static GaimCmdRet | |
493 perl_cmd_cb(GaimConversation *conv, const gchar *command, | |
494 gchar **args, gchar **error, void *data) | |
495 { | |
496 int i = 0, count, ret_value = GAIM_CMD_RET_OK; | |
497 SV *cmdSV, *tmpSV, *convSV; | |
498 GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)data; | |
499 | |
500 dSP; | |
501 ENTER; | |
502 SAVETMPS; | |
503 PUSHMARK(SP); | |
504 | |
505 /* Push the conversation onto the perl stack */ | |
506 convSV = sv_2mortal(gaim_perl_bless_object(conv, "Gaim::Conversation")); | |
507 XPUSHs(convSV); | |
508 | |
509 /* Push the command string onto the perl stack */ | |
510 cmdSV = newSVpv(command, 0); | |
511 cmdSV = sv_2mortal(cmdSV); | |
512 XPUSHs(cmdSV); | |
513 | |
514 /* Push the data onto the perl stack */ | |
515 XPUSHs((SV *)handler->data); | |
516 | |
517 /* Push any arguments we may have */ | |
518 for (i = 0; args[i] != NULL; i++) { | |
519 /* XXX The mortality of these created SV's should prevent | |
520 * memory issues, if I read/understood everything correctly... | |
521 */ | |
522 tmpSV = newSVpv(args[i], 0); | |
523 tmpSV = sv_2mortal(tmpSV); | |
524 XPUSHs(tmpSV); | |
525 } | |
526 | |
527 PUTBACK; | |
528 count = call_sv(handler->callback, G_EVAL|G_SCALAR); | |
529 | |
530 if (count != 1) | |
531 croak("call_sv: Did not return the correct number of values.\n"); | |
532 | |
533 SPAGAIN; | |
534 | |
535 ret_value = POPi; | |
536 | |
537 PUTBACK; | |
538 FREETMPS; | |
539 LEAVE; | |
540 | |
541 return ret_value; | |
542 } | |
543 | |
544 GaimCmdId | |
545 gaim_perl_cmd_register(GaimPlugin *plugin, const gchar *command, | |
546 const gchar *args, GaimCmdPriority priority, | |
547 GaimCmdFlag flag, const gchar *prpl_id, SV *callback, | |
548 const gchar *helpstr, SV *data) | |
549 { | |
550 GaimPerlCmdHandler *handler; | |
551 | |
552 handler = g_new0(GaimPerlCmdHandler, 1); | |
553 handler->plugin = plugin; | |
554 handler->cmd = g_strdup(command); | |
555 handler->prpl_id = g_strdup(prpl_id); | |
556 | |
557 if (callback != NULL && callback != &PL_sv_undef) | |
558 handler->callback = newSVsv(callback); | |
559 else | |
560 handler->callback = NULL; | |
561 | |
562 if (data != NULL && data != &PL_sv_undef) | |
563 handler->data = newSVsv(data); | |
564 else | |
565 handler->data = NULL; | |
566 | |
567 cmd_handlers = g_list_append(cmd_handlers, handler); | |
568 | |
569 handler->id = gaim_cmd_register(command, args, priority, flag, prpl_id, | |
570 GAIM_CMD_FUNC(perl_cmd_cb), helpstr, | |
571 handler); | |
572 | |
573 return handler->id; | |
574 } | |
575 | |
576 static void | |
577 destroy_cmd_handler(GaimPerlCmdHandler *handler) | |
578 { | |
579 cmd_handlers = g_list_remove(cmd_handlers, handler); | |
580 | |
581 if (handler->callback != NULL) | |
582 SvREFCNT_dec(handler->callback); | |
583 | |
584 if (handler->data != NULL) | |
585 SvREFCNT_dec(handler->data); | |
586 | |
587 g_free(handler->cmd); | |
588 g_free(handler->prpl_id); | |
589 g_free(handler); | |
590 } | |
591 | |
592 void | |
593 gaim_perl_cmd_clear_for_plugin(GaimPlugin *plugin) | |
594 { | |
595 GList *l, *l_next; | |
596 | |
597 for (l = cmd_handlers; l != NULL; l = l_next) { | |
598 GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)l->data; | |
599 | |
600 l_next = l->next; | |
601 | |
602 if (handler->plugin == plugin) | |
603 destroy_cmd_handler(handler); | |
604 } | |
605 } | |
606 | |
607 static GaimPerlCmdHandler * | |
608 find_cmd_handler(GaimCmdId id) | |
609 { | |
610 GList *l; | |
611 | |
612 for (l = cmd_handlers; l != NULL; l = l->next) { | |
613 GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)l->data; | |
614 | |
615 if (handler->id == id) | |
616 return handler; | |
617 } | |
618 | |
619 return NULL; | |
620 } | |
621 | |
622 void | |
623 gaim_perl_cmd_unregister(GaimCmdId id) | |
624 { | |
625 GaimPerlCmdHandler *handler; | |
626 | |
627 handler = find_cmd_handler(id); | |
628 | |
629 if (handler == NULL) { | |
630 croak("Invalid command id in removing a perl command handler.\n"); | |
631 return; | |
632 } | |
633 | |
634 gaim_cmd_unregister(id); | |
635 destroy_cmd_handler(handler); | |
636 } |