comparison plugins/perl/perl-handlers.c @ 12988:b457aa723bab

[gaim-migrate @ 15341] Perl plugins can now have more than one plugin action. This isn't exactly the nicest way to have done this, as it requires a "global" plugin_actions hash to work, but I couldn't get the cleaner way to work and this is better than nothing. committer: Tailor Script <tailor@pidgin.im>
author Etan Reisner <pidgin@unreliablesource.net>
date Sun, 22 Jan 2006 10:29:34 +0000
parents e1603fd610fa
children 7fdd1c0c585c
comparison
equal deleted inserted replaced
12987:750968cab201 12988:b457aa723bab
12 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ 12 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */
13 #ifndef PERL_MAGIC_ext 13 #ifndef PERL_MAGIC_ext
14 #define PERL_MAGIC_ext '~' 14 #define PERL_MAGIC_ext '~'
15 #endif 15 #endif
16 16
17 /* For now a plugin can only have one action */ 17 void
18 void 18 gaim_perl_plugin_action_cb(GaimPluginAction *action)
19 gaim_perl_plugin_action_cb(GaimPluginAction * gpa) 19 {
20 { 20 SV **callback;
21 HV *hv = NULL;
22 gchar *hvname;
23 GaimPlugin *plugin;
24 GaimPerlScript *gps;
21 dSP; 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
22 ENTER; 36 ENTER;
23 SAVETMPS; 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
24 PUSHMARK(sp); 44 PUSHMARK(sp);
25 45 XPUSHs(gaim_perl_bless_object(gps->plugin, "Gaim::Plugin"));
26 /* We put the plugin handle on the stack so it can pass it along */ 46 PUTBACK;
27 /* to anything called from the callback. It is supposed to pass */ 47
28 /* the Action, but there is no way to access the plugin handle from */ 48 call_sv(*callback, G_VOID | G_DISCARD);
29 /* the GaimPluginAction in perl...yet. */
30
31 XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin"));
32 PUTBACK;
33
34 /* gaim_perl_plugin_action_callback_sub defined in the header is set
35 * in perl.c during plugin probe by a PLUGIN_INFO hash value limiting
36 * us to only one action for right now even though the action member
37 * of GaimPluginInfo can take (does take) a GList. */
38 call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR);
39 SPAGAIN; 49 SPAGAIN;
40 50
41 PUTBACK; 51 PUTBACK;
42 FREETMPS; 52 FREETMPS;
43 LEAVE; 53 LEAVE;
44 } 54 }
45 55
46 GList * 56 GList *
47 gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) 57 gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context)
48 { 58 {
49 GaimPluginAction *act = NULL; 59 GList *l = NULL;
50 GList *gl = NULL; 60 GaimPerlScript *gps;
51 61 int i = 0, count = 0;
52 /* TODO: Fix the way we create action handlers so we can have more 62 dSP;
53 * than one action in perl. Maybe there is a clever work around, but 63
54 * so far I have not figured it out. There is no way to tie the perl 64 gps = (GaimPerlScript *)plugin->info->extra_info;
55 * sub's name to the callback function without these global variables 65
56 * and there is no way to create a callback on the fly so each would 66 ENTER;
57 * have to be hardcoded--more than one would just be arbitrary. */ 67 SAVETMPS;
58 act = gaim_plugin_action_new(gaim_perl_plugin_action_label, 68
59 gaim_perl_plugin_action_cb); 69 PUSHMARK(SP);
60 gl = g_list_append(gl, act); 70 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin")));
61 71 /* XXX This *will* cease working correctly if context gets changed to
62 return gl; 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;
63 } 104 }
64 105
65 GtkWidget * 106 GtkWidget *
66 gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) 107 gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin)
67 { 108 {