Mercurial > pidgin3 / file comparison

comparison: libpurple/plugins/perl/perl-handlers.c

libpurple/plugins/perl/perl-handlers.c

branch
cpw.khc.msnp14
changeset 20478
46933dc62880
parent 20472
6a6d2ef151e6
parent 16140
362e0ca15d3a
child 20481
65485e2ed8a3
equal deleted inserted replaced
20476:198222e01a7d 20478:46933dc62880
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 purple_perl_plugin_action_cb(PurplePluginAction *action)
19 {
20 SV **callback;
21 HV *hv = NULL;
22 gchar *hvname;
23 PurplePlugin *plugin;
24 PurplePerlScript *gps;
25 dSP;
26
27 plugin = action->plugin;
28 gps = (PurplePerlScript *)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.", purple_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, purple_plugin_get_name(plugin));
43
44 PUSHMARK(sp);
45 XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::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 purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context)
58 {
59 GList *l = NULL;
60 PurplePerlScript *gps;
61 int i = 0, count = 0;
62 dSP;
63
64 gps = (PurplePerlScript *)plugin->info->extra_info;
65
66 ENTER;
67 SAVETMPS;
68
69 PUSHMARK(SP);
70 XPUSHs(sv_2mortal(purple_perl_bless_object(plugin, "Purple::Plugin")));
71 /* XXX This *will* cease working correctly if context gets changed to
72 * ever be able to hold anything other than a PurpleConnection */
73 if (context != NULL)
74 XPUSHs(sv_2mortal(purple_perl_bless_object(context,
75 "Purple::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 PurplePluginAction *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 = purple_plugin_action_new(g_strdup(label), purple_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 PURPLE_GTKPERL
108 GtkWidget *
109 purple_perl_gtk_get_plugin_frame(PurplePlugin *plugin)
110 {
111 SV * sv;
112 int count;
113 MAGIC *mg;
114 GtkWidget *ret;
115 PurplePerlScript *gps;
116 dSP;
117
118 gps = (PurplePerlScript *)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 PurplePluginPrefFrame *
146 purple_perl_get_plugin_frame(PurplePlugin *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 PurplePerlScript *gps;
152 PurplePluginPrefFrame *ret_frame;
153 dSP;
154
155 gps = (PurplePerlScript *)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 = (PurplePluginPrefFrame *)purple_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(PurplePerlTimeoutHandler *handler)
183 {
184 timeout_handlers = g_list_remove(timeout_handlers, handler);
185
186 if (handler->iotag > 0)
187 g_source_remove(handler->iotag);
188
189 if (handler->callback != NULL)
190 SvREFCNT_dec(handler->callback);
191
192 if (handler->data != NULL)
193 SvREFCNT_dec(handler->data);
194
195 g_free(handler);
196 }
197
198 static void
199 destroy_signal_handler(PurplePerlSignalHandler *handler)
200 {
201 signal_handlers = g_list_remove(signal_handlers, handler);
202
203 if (handler->callback != NULL)
204 SvREFCNT_dec(handler->callback);
205
206 if (handler->data != NULL)
207 SvREFCNT_dec(handler->data);
208
209 g_free(handler->signal);
210 g_free(handler);
211 }
212
213 static gboolean
214 perl_timeout_cb(gpointer data)
215 {
216 PurplePerlTimeoutHandler *handler = (PurplePerlTimeoutHandler *)data;
217
218 dSP;
219 ENTER;
220 SAVETMPS;
221 PUSHMARK(sp);
222 XPUSHs((SV *)handler->data);
223 PUTBACK;
224 call_sv(handler->callback, G_EVAL | G_SCALAR);
225 SPAGAIN;
226
227 PUTBACK;
228 FREETMPS;
229 LEAVE;
230
231 /* We're returning FALSE, so no need to manually remove the source */
232 handler->iotag = 0;
233
234 destroy_timeout_handler(handler);
235
236 return FALSE;
237 }
238
239 typedef void *DATATYPE;
240
241 static void *
242 perl_signal_cb(va_list args, void *data)
243 {
244 PurplePerlSignalHandler *handler = (PurplePerlSignalHandler *)data;
245 void *ret_val = NULL;
246 int i;
247 int count;
248 int value_count;
249 PurpleValue *ret_value, **values;
250 SV **sv_args;
251 DATATYPE **copy_args;
252 STRLEN na;
253
254 dSP;
255 ENTER;
256 SAVETMPS;
257 PUSHMARK(sp);
258
259 purple_signal_get_values(handler->instance, handler->signal,
260 &ret_value, &value_count, &values);
261
262 sv_args = g_new(SV *, value_count);
263 copy_args = g_new(void **, value_count);
264
265 for (i = 0; i < value_count; i++) {
266 sv_args[i] = purple_perl_sv_from_vargs(values[i],
267 (va_list*)&args,
268 &copy_args[i]);
269
270 XPUSHs(sv_args[i]);
271 }
272
273 XPUSHs((SV *)handler->data);
274
275 PUTBACK;
276
277 if (ret_value != NULL) {
278 count = call_sv(handler->callback, G_EVAL | G_SCALAR);
279
280 SPAGAIN;
281
282 if (count != 1)
283 croak("Uh oh! call_sv returned %i != 1", i);
284 else
285 ret_val = purple_perl_data_from_sv(ret_value, POPs);
286 } else {
287 call_sv(handler->callback, G_SCALAR);
288
289 SPAGAIN;
290 }
291
292 if (SvTRUE(ERRSV)) {
293 purple_debug_error("perl",
294 "Perl function exited abnormally: %s\n",
295 SvPV(ERRSV, na));
296 }
297
298 /* See if any parameters changed. */
299 for (i = 0; i < value_count; i++) {
300 if (purple_value_is_outgoing(values[i])) {
301 switch (purple_value_get_type(values[i])) {
302 case PURPLE_TYPE_BOOLEAN:
303 *((gboolean *)copy_args[i]) = SvIV(sv_args[i]);
304 break;
305
306 case PURPLE_TYPE_INT:
307 *((int *)copy_args[i]) = SvIV(sv_args[i]);
308 break;
309
310 case PURPLE_TYPE_UINT:
311 *((unsigned int *)copy_args[i]) = SvUV(sv_args[i]);
312 break;
313
314 case PURPLE_TYPE_LONG:
315 *((long *)copy_args[i]) = SvIV(sv_args[i]);
316 break;
317
318 case PURPLE_TYPE_ULONG:
319 *((unsigned long *)copy_args[i]) = SvUV(sv_args[i]);
320 break;
321
322 case PURPLE_TYPE_INT64:
323 *((gint64 *)copy_args[i]) = SvIV(sv_args[i]);
324 break;
325
326 case PURPLE_TYPE_UINT64:
327 *((guint64 *)copy_args[i]) = SvUV(sv_args[i]);
328 break;
329
330 case PURPLE_TYPE_STRING:
331 if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) {
332 g_free(*((char **)copy_args[i]));
333 *((char **)copy_args[i]) =
334 g_strdup(SvPV(sv_args[i], na));
335 }
336 break;
337
338 case PURPLE_TYPE_POINTER:
339 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
340 break;
341
342 case PURPLE_TYPE_BOXED:
343 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
344 break;
345
346 default:
347 break;
348 }
349
350 #if 0
351 *((void **)copy_args[i]) = purple_perl_data_from_sv(values[i],
352 sv_args[i]);
353 #endif
354 }
355 }
356
357 PUTBACK;
358 FREETMPS;
359 LEAVE;
360
361 g_free(sv_args);
362 g_free(copy_args);
363
364 purple_debug_misc("perl", "ret_val = %p\n", ret_val);
365
366 return ret_val;
367 }
368
369 static PurplePerlSignalHandler *
370 find_signal_handler(PurplePlugin *plugin, void *instance, const char *signal)
371 {
372 PurplePerlSignalHandler *handler;
373 GList *l;
374
375 for (l = signal_handlers; l != NULL; l = l->next) {
376 handler = (PurplePerlSignalHandler *)l->data;
377
378 if (handler->plugin == plugin &&
379 handler->instance == instance &&
380 !strcmp(handler->signal, signal)) {
381 return handler;
382 }
383 }
384
385 return NULL;
386 }
387
388 void
389 purple_perl_timeout_add(PurplePlugin *plugin, int seconds, SV *callback, SV *data)
390 {
391 PurplePerlTimeoutHandler *handler;
392
393 if (plugin == NULL) {
394 croak("Invalid handle in adding perl timeout handler.\n");
395 return;
396 }
397
398 handler = g_new0(PurplePerlTimeoutHandler, 1);
399
400 handler->plugin = plugin;
401 handler->callback = (callback != NULL && callback != &PL_sv_undef
402 ? newSVsv(callback) : NULL);
403 handler->data = (data != NULL && data != &PL_sv_undef
404 ? newSVsv(data) : NULL);
405
406 timeout_handlers = g_list_append(timeout_handlers, handler);
407
408 handler->iotag = g_timeout_add(seconds * 1000, perl_timeout_cb, handler);
409 }
410
411 void
412 purple_perl_timeout_clear_for_plugin(PurplePlugin *plugin)
413 {
414 PurplePerlTimeoutHandler *handler;
415 GList *l, *l_next;
416
417 for (l = timeout_handlers; l != NULL; l = l_next) {
418 l_next = l->next;
419
420 handler = (PurplePerlTimeoutHandler *)l->data;
421
422 if (handler->plugin == plugin)
423 destroy_timeout_handler(handler);
424 }
425 }
426
427 void
428 purple_perl_timeout_clear(void)
429 {
430 while (timeout_handlers != NULL)
431 destroy_timeout_handler(timeout_handlers->data);
432 }
433
434 void
435 purple_perl_signal_connect(PurplePlugin *plugin, void *instance,
436 const char *signal, SV *callback, SV *data,
437 int priority)
438 {
439 PurplePerlSignalHandler *handler;
440
441 handler = g_new0(PurplePerlSignalHandler, 1);
442 handler->plugin = plugin;
443 handler->instance = instance;
444 handler->signal = g_strdup(signal);
445 handler->callback = (callback != NULL &&
446 callback != &PL_sv_undef ? newSVsv(callback)
447 : NULL);
448 handler->data = (data != NULL &&
449 data != &PL_sv_undef ? newSVsv(data) : NULL);
450
451 signal_handlers = g_list_append(signal_handlers, handler);
452
453 purple_signal_connect_priority_vargs(instance, signal, plugin,
454 PURPLE_CALLBACK(perl_signal_cb),
455 handler, priority);
456 }
457
458 void
459 purple_perl_signal_disconnect(PurplePlugin *plugin, void *instance,
460 const char *signal)
461 {
462 PurplePerlSignalHandler *handler;
463
464 handler = find_signal_handler(plugin, instance, signal);
465
466 if (handler == NULL) {
467 croak("Invalid signal handler information in "
468 "disconnecting a perl signal handler.\n");
469 return;
470 }
471
472 destroy_signal_handler(handler);
473 }
474
475 void
476 purple_perl_signal_clear_for_plugin(PurplePlugin *plugin)
477 {
478 PurplePerlSignalHandler *handler;
479 GList *l, *l_next;
480
481 for (l = signal_handlers; l != NULL; l = l_next) {
482 l_next = l->next;
483
484 handler = (PurplePerlSignalHandler *)l->data;
485
486 if (handler->plugin == plugin)
487 destroy_signal_handler(handler);
488 }
489 }
490
491 void
492 purple_perl_signal_clear(void)
493 {
494 while (signal_handlers != NULL)
495 destroy_signal_handler(signal_handlers->data);
496 }
497
498 static PurpleCmdRet
499 perl_cmd_cb(PurpleConversation *conv, const gchar *command,
500 gchar **args, gchar **error, void *data)
501 {
502 int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
503 SV *cmdSV, *tmpSV, *convSV;
504 PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)data;
505
506 dSP;
507 ENTER;
508 SAVETMPS;
509 PUSHMARK(SP);
510
511 /* Push the conversation onto the perl stack */
512 convSV = sv_2mortal(purple_perl_bless_object(conv, "Purple::Conversation"));
513 XPUSHs(convSV);
514
515 /* Push the command string onto the perl stack */
516 cmdSV = newSVpv(command, 0);
517 cmdSV = sv_2mortal(cmdSV);
518 XPUSHs(cmdSV);
519
520 /* Push the data onto the perl stack */
521 XPUSHs((SV *)handler->data);
522
523 /* Push any arguments we may have */
524 for (i = 0; args[i] != NULL; i++) {
525 /* XXX The mortality of these created SV's should prevent
526 * memory issues, if I read/understood everything correctly...
527 */
528 tmpSV = newSVpv(args[i], 0);
529 tmpSV = sv_2mortal(tmpSV);
530 XPUSHs(tmpSV);
531 }
532
533 PUTBACK;
534 count = call_sv(handler->callback, G_EVAL|G_SCALAR);
535
536 if (count != 1)
537 croak("call_sv: Did not return the correct number of values.\n");
538
539 SPAGAIN;
540
541 ret_value = POPi;
542
543 PUTBACK;
544 FREETMPS;
545 LEAVE;
546
547 return ret_value;
548 }
549
550 PurpleCmdId
551 purple_perl_cmd_register(PurplePlugin *plugin, const gchar *command,
552 const gchar *args, PurpleCmdPriority priority,
553 PurpleCmdFlag flag, const gchar *prpl_id, SV *callback,
554 const gchar *helpstr, SV *data)
555 {
556 PurplePerlCmdHandler *handler;
557
558 handler = g_new0(PurplePerlCmdHandler, 1);
559 handler->plugin = plugin;
560 handler->cmd = g_strdup(command);
561 handler->prpl_id = g_strdup(prpl_id);
562
563 if (callback != NULL && callback != &PL_sv_undef)
564 handler->callback = newSVsv(callback);
565 else
566 handler->callback = NULL;
567
568 if (data != NULL && data != &PL_sv_undef)
569 handler->data = newSVsv(data);
570 else
571 handler->data = NULL;
572
573 cmd_handlers = g_list_append(cmd_handlers, handler);
574
575 handler->id = purple_cmd_register(command, args, priority, flag, prpl_id,
576 PURPLE_CMD_FUNC(perl_cmd_cb), helpstr,
577 handler);
578
579 return handler->id;
580 }
581
582 static void
583 destroy_cmd_handler(PurplePerlCmdHandler *handler)
584 {
585 cmd_handlers = g_list_remove(cmd_handlers, handler);
586
587 if (handler->callback != NULL)
588 SvREFCNT_dec(handler->callback);
589
590 if (handler->data != NULL)
591 SvREFCNT_dec(handler->data);
592
593 g_free(handler->cmd);
594 g_free(handler->prpl_id);
595 g_free(handler);
596 }
597
598 void
599 purple_perl_cmd_clear_for_plugin(PurplePlugin *plugin)
600 {
601 GList *l, *l_next;
602
603 for (l = cmd_handlers; l != NULL; l = l_next) {
604 PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)l->data;
605
606 l_next = l->next;
607
608 if (handler->plugin == plugin)
609 destroy_cmd_handler(handler);
610 }
611 }
612
613 static PurplePerlCmdHandler *
614 find_cmd_handler(PurpleCmdId id)
615 {
616 GList *l;
617
618 for (l = cmd_handlers; l != NULL; l = l->next) {
619 PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)l->data;
620
621 if (handler->id == id)
622 return handler;
623 }
624
625 return NULL;
626 }
627
628 void
629 purple_perl_cmd_unregister(PurpleCmdId id)
630 {
631 PurplePerlCmdHandler *handler;
632
633 handler = find_cmd_handler(id);
634
635 if (handler == NULL) {
636 croak("Invalid command id in removing a perl command handler.\n");
637 return;
638 }
639
640 purple_cmd_unregister(id);
641 destroy_cmd_handler(handler);
642 }

Mercurial Repository: pidgin3

mercurial