Mercurial > pidgin3 / file comparison

comparison: plugins/perl/perl-handlers.c

plugins/perl/perl-handlers.c

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

Mercurial Repository: pidgin3

mercurial