Mercurial > pidgin3 / file comparison

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

libpurple/plugins/perl/perl-handlers.c

changeset 19336
065a79d2d0e5
parent 18165
fb6f9d0130aa
child 22845
7ccb529edf3f
equal deleted inserted replaced
19335:4613b53d5741 19336:065a79d2d0e5
20 SV **callback; 20 SV **callback;
21 HV *hv = NULL; 21 HV *hv = NULL;
22 gchar *hvname; 22 gchar *hvname;
23 PurplePlugin *plugin; 23 PurplePlugin *plugin;
24 PurplePerlScript *gps; 24 PurplePerlScript *gps;
25 STRLEN na;
25 dSP; 26 dSP;
26 27
27 plugin = action->plugin; 28 plugin = action->plugin;
28 gps = (PurplePerlScript *)plugin->info->extra_info; 29 gps = (PurplePerlScript *)plugin->info->extra_info;
29 hvname = g_strdup_printf("%s::plugin_actions", gps->package); 30 hvname = g_strdup_printf("%s::plugin_actions", gps->package);
43 44
44 PUSHMARK(sp); 45 PUSHMARK(sp);
45 XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin")); 46 XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin"));
46 PUTBACK; 47 PUTBACK;
47 48
48 call_sv(*callback, G_VOID | G_DISCARD); 49 call_sv(*callback, G_EVAL | G_VOID | G_DISCARD);
50
49 SPAGAIN; 51 SPAGAIN;
52
53 if (SvTRUE(ERRSV)) {
54 purple_debug_error("perl",
55 "Perl plugin action function exited abnormally: %s\n",
56 SvPV(ERRSV, na));
57 }
50 58
51 PUTBACK; 59 PUTBACK;
52 FREETMPS; 60 FREETMPS;
53 LEAVE; 61 LEAVE;
54 } 62 }
57 purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context) 65 purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context)
58 { 66 {
59 GList *l = NULL; 67 GList *l = NULL;
60 PurplePerlScript *gps; 68 PurplePerlScript *gps;
61 int i = 0, count = 0; 69 int i = 0, count = 0;
70 STRLEN na;
62 dSP; 71 dSP;
63 72
64 gps = (PurplePerlScript *)plugin->info->extra_info; 73 gps = (PurplePerlScript *)plugin->info->extra_info;
65 74
66 ENTER; 75 ENTER;
75 "Purple::Connection"))); 84 "Purple::Connection")));
76 else 85 else
77 XPUSHs(&PL_sv_undef); 86 XPUSHs(&PL_sv_undef);
78 PUTBACK; 87 PUTBACK;
79 88
80 count = call_pv(gps->plugin_action_sub, G_ARRAY); 89 count = call_pv(gps->plugin_action_sub, G_EVAL | G_ARRAY);
81 90
82 SPAGAIN; 91 SPAGAIN;
92
93 if (SvTRUE(ERRSV)) {
94 purple_debug_error("perl",
95 "Perl plugin actions lookup exited abnormally: %s\n",
96 SvPV(ERRSV, na));
97 }
83 98
84 if (count == 0) 99 if (count == 0)
85 croak("The plugin_actions sub didn't return anything.\n"); 100 croak("The plugin_actions sub didn't return anything.\n");
86 101
87 for (i = 0; i < count; i++) { 102 for (i = 0; i < count; i++) {
111 SV * sv; 126 SV * sv;
112 int count; 127 int count;
113 MAGIC *mg; 128 MAGIC *mg;
114 GtkWidget *ret; 129 GtkWidget *ret;
115 PurplePerlScript *gps; 130 PurplePerlScript *gps;
131 STRLEN na;
116 dSP; 132 dSP;
117 133
118 gps = (PurplePerlScript *)plugin->info->extra_info; 134 gps = (PurplePerlScript *)plugin->info->extra_info;
119 135
120 ENTER; 136 ENTER;
121 SAVETMPS; 137 SAVETMPS;
122 138
123 count = call_pv(gps->gtk_prefs_sub, G_SCALAR | G_NOARGS); 139 count = call_pv(gps->gtk_prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);
124 if (count != 1) 140 if (count != 1)
125 croak("call_pv: Did not return the correct number of values.\n"); 141 croak("call_pv: Did not return the correct number of values.\n");
126 142
127 /* the frame was created in a perl sub and is returned */ 143 /* the frame was created in a perl sub and is returned */
128 SPAGAIN; 144 SPAGAIN;
145
146 if (SvTRUE(ERRSV)) {
147 purple_debug_error("perl",
148 "Perl gtk plugin frame init exited abnormally: %s\n",
149 SvPV(ERRSV, na));
150 }
129 151
130 /* We have a Gtk2::Frame on top of the stack */ 152 /* We have a Gtk2::Frame on top of the stack */
131 sv = POPs; 153 sv = POPs;
132 154
133 /* The magic field hides the pointer to the actual GtkWidget */ 155 /* The magic field hides the pointer to the actual GtkWidget */
148 /* Sets up the Perl Stack for our call back into the script to run the 170 /* Sets up the Perl Stack for our call back into the script to run the
149 * plugin_pref... sub */ 171 * plugin_pref... sub */
150 int count; 172 int count;
151 PurplePerlScript *gps; 173 PurplePerlScript *gps;
152 PurplePluginPrefFrame *ret_frame; 174 PurplePluginPrefFrame *ret_frame;
175 STRLEN na;
153 dSP; 176 dSP;
154 177
155 gps = (PurplePerlScript *)plugin->info->extra_info; 178 gps = (PurplePerlScript *)plugin->info->extra_info;
156 179
157 ENTER; 180 ENTER;
159 /* Some perl magic to run perl_plugin_pref_frame_SV perl sub and 182 /* Some perl magic to run perl_plugin_pref_frame_SV perl sub and
160 * return the frame */ 183 * return the frame */
161 PUSHMARK(SP); 184 PUSHMARK(SP);
162 PUTBACK; 185 PUTBACK;
163 186
164 count = call_pv(gps->prefs_sub, G_SCALAR | G_NOARGS); 187 count = call_pv(gps->prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);
165 188
166 SPAGAIN; 189 SPAGAIN;
190
191 if (SvTRUE(ERRSV)) {
192 purple_debug_error("perl",
193 "Perl plugin prefs frame init exited abnormally: %s\n",
194 SvPV(ERRSV, na));
195 }
167 196
168 if (count != 1) 197 if (count != 1)
169 croak("call_pv: Did not return the correct number of values.\n"); 198 croak("call_pv: Did not return the correct number of values.\n");
170 /* the frame was created in a perl sub and is returned */ 199 /* the frame was created in a perl sub and is returned */
171 ret_frame = (PurplePluginPrefFrame *)purple_perl_ref_object(POPs); 200 ret_frame = (PurplePluginPrefFrame *)purple_perl_ref_object(POPs);
213 static gboolean 242 static gboolean
214 perl_timeout_cb(gpointer data) 243 perl_timeout_cb(gpointer data)
215 { 244 {
216 PurplePerlTimeoutHandler *handler = (PurplePerlTimeoutHandler *)data; 245 PurplePerlTimeoutHandler *handler = (PurplePerlTimeoutHandler *)data;
217 gboolean ret = FALSE; 246 gboolean ret = FALSE;
247 STRLEN na;
218 248
219 dSP; 249 dSP;
220 ENTER; 250 ENTER;
221 SAVETMPS; 251 SAVETMPS;
222 PUSHMARK(sp); 252 PUSHMARK(sp);
223 XPUSHs((SV *)handler->data); 253 XPUSHs((SV *)handler->data);
224 PUTBACK; 254 PUTBACK;
225 call_sv(handler->callback, G_EVAL | G_SCALAR); 255 call_sv(handler->callback, G_EVAL | G_SCALAR);
226 SPAGAIN; 256 SPAGAIN;
257
258 if (SvTRUE(ERRSV)) {
259 purple_debug_error("perl",
260 "Perl timeout function exited abnormally: %s\n",
261 SvPV(ERRSV, na));
262 }
227 263
228 ret = POPi; 264 ret = POPi;
229 265
230 PUTBACK; 266 PUTBACK;
231 FREETMPS; 267 FREETMPS;
283 if (count != 1) 319 if (count != 1)
284 croak("Uh oh! call_sv returned %i != 1", i); 320 croak("Uh oh! call_sv returned %i != 1", i);
285 else 321 else
286 ret_val = purple_perl_data_from_sv(ret_value, POPs); 322 ret_val = purple_perl_data_from_sv(ret_value, POPs);
287 } else { 323 } else {
288 call_sv(handler->callback, G_SCALAR); 324 call_sv(handler->callback, G_EVAL | G_SCALAR);
289 325
290 SPAGAIN; 326 SPAGAIN;
291 } 327 }
292 328
293 if (SvTRUE(ERRSV)) { 329 if (SvTRUE(ERRSV)) {
499 static PurpleCmdRet 535 static PurpleCmdRet
500 perl_cmd_cb(PurpleConversation *conv, const gchar *command, 536 perl_cmd_cb(PurpleConversation *conv, const gchar *command,
501 gchar **args, gchar **error, void *data) 537 gchar **args, gchar **error, void *data)
502 { 538 {
503 int i = 0, count, ret_value = PURPLE_CMD_RET_OK; 539 int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
540 STRLEN na;
504 SV *cmdSV, *tmpSV, *convSV; 541 SV *cmdSV, *tmpSV, *convSV;
505 PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)data; 542 PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)data;
506 543
507 dSP; 544 dSP;
508 ENTER; 545 ENTER;
530 tmpSV = sv_2mortal(tmpSV); 567 tmpSV = sv_2mortal(tmpSV);
531 XPUSHs(tmpSV); 568 XPUSHs(tmpSV);
532 } 569 }
533 570
534 PUTBACK; 571 PUTBACK;
535 count = call_sv(handler->callback, G_EVAL|G_SCALAR); 572 count = call_sv(handler->callback, G_EVAL | G_SCALAR);
536 573
537 if (count != 1) 574 if (count != 1)
538 croak("call_sv: Did not return the correct number of values.\n"); 575 croak("call_sv: Did not return the correct number of values.\n");
576
577 if (SvTRUE(ERRSV)) {
578 purple_debug_error("perl",
579 "Perl plugin command function exited abnormally: %s\n",
580 SvPV(ERRSV, na));
581 }
539 582
540 SPAGAIN; 583 SPAGAIN;
541 584
542 ret_value = POPi; 585 ret_value = POPi;
543 586

Mercurial Repository: pidgin3

mercurial