Mercurial > pidgin3 / file comparison

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

libgaim/plugins/perl/perl-handlers.c

branch
gaim
changeset 20470
77693555855f
parent 13017
d3bcadbf3094
parent 14779
1b71da367f56
child 20471
1966704b3e42
equal deleted inserted replaced
13071:b98e72d4089a 20470:77693555855f
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 &copy_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 }

Mercurial Repository: pidgin3

mercurial