Mercurial > pidgin3 / file comparison

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

libpurple/plugins/perl/perl-handlers.c

changeset 23980
a38cbb35eecf
parent 23931
8975bb78b51a
child 25381
9a510397bf31
equal deleted inserted replaced
23979:936d7ef5cece 23980:a38cbb35eecf
21 SV **callback; 21 SV **callback;
22 HV *hv = NULL; 22 HV *hv = NULL;
23 gchar *hvname; 23 gchar *hvname;
24 PurplePlugin *plugin; 24 PurplePlugin *plugin;
25 PurplePerlScript *gps; 25 PurplePerlScript *gps;
26 STRLEN na;
27 dSP; 26 dSP;
28 27
29 plugin = action->plugin; 28 plugin = action->plugin;
30 gps = (PurplePerlScript *)plugin->info->extra_info; 29 gps = (PurplePerlScript *)plugin->info->extra_info;
31 hvname = g_strdup_printf("%s::plugin_actions", gps->package); 30 hvname = g_strdup_printf("%s::plugin_actions", gps->package);
52 SPAGAIN; 51 SPAGAIN;
53 52
54 if (SvTRUE(ERRSV)) { 53 if (SvTRUE(ERRSV)) {
55 purple_debug_error("perl", 54 purple_debug_error("perl",
56 "Perl plugin action function exited abnormally: %s\n", 55 "Perl plugin action function exited abnormally: %s\n",
57 SvPV(ERRSV, na)); 56 SvPVutf8_nolen(ERRSV));
58 } 57 }
59 58
60 PUTBACK; 59 PUTBACK;
61 FREETMPS; 60 FREETMPS;
62 LEAVE; 61 LEAVE;
66 purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context) 65 purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context)
67 { 66 {
68 GList *l = NULL; 67 GList *l = NULL;
69 PurplePerlScript *gps; 68 PurplePerlScript *gps;
70 int i = 0, count = 0; 69 int i = 0, count = 0;
71 STRLEN na;
72 dSP; 70 dSP;
73 71
74 gps = plugin->info->extra_info; 72 gps = plugin->info->extra_info;
75 73
76 ENTER; 74 ENTER;
92 SPAGAIN; 90 SPAGAIN;
93 91
94 if (SvTRUE(ERRSV)) { 92 if (SvTRUE(ERRSV)) {
95 purple_debug_error("perl", 93 purple_debug_error("perl",
96 "Perl plugin actions lookup exited abnormally: %s\n", 94 "Perl plugin actions lookup exited abnormally: %s\n",
97 SvPV(ERRSV, na)); 95 SvPVutf8_nolen(ERRSV));
98 } 96 }
99 97
100 if (count == 0) 98 if (count == 0)
101 croak("The plugin_actions sub didn't return anything.\n"); 99 croak("The plugin_actions sub didn't return anything.\n");
102 100
103 for (i = 0; i < count; i++) { 101 for (i = 0; i < count; i++) {
104 SV *sv; 102 SV *sv;
105 gchar *label; 103 PurplePluginAction *act;
106 PurplePluginAction *act = NULL;
107 104
108 sv = POPs; 105 sv = POPs;
109 label = SvPV_nolen(sv); 106 act = purple_plugin_action_new(SvPVutf8_nolen(sv), purple_perl_plugin_action_cb);
110 /* XXX I think this leaks, but doing it without the strdup
111 * just showed garbage */
112 act = purple_plugin_action_new(g_strdup(label), purple_perl_plugin_action_cb);
113 l = g_list_prepend(l, act); 107 l = g_list_prepend(l, act);
114 } 108 }
115 109
116 PUTBACK; 110 PUTBACK;
117 FREETMPS; 111 FREETMPS;
127 SV * sv; 121 SV * sv;
128 int count; 122 int count;
129 MAGIC *mg; 123 MAGIC *mg;
130 GtkWidget *ret; 124 GtkWidget *ret;
131 PurplePerlScript *gps; 125 PurplePerlScript *gps;
132 STRLEN na;
133 dSP; 126 dSP;
134 127
135 gps = plugin->info->extra_info; 128 gps = plugin->info->extra_info;
136 129
137 ENTER; 130 ENTER;
145 SPAGAIN; 138 SPAGAIN;
146 139
147 if (SvTRUE(ERRSV)) { 140 if (SvTRUE(ERRSV)) {
148 purple_debug_error("perl", 141 purple_debug_error("perl",
149 "Perl gtk plugin frame init exited abnormally: %s\n", 142 "Perl gtk plugin frame init exited abnormally: %s\n",
150 SvPV(ERRSV, na)); 143 SvPVutf8_nolen(ERRSV));
151 } 144 }
152 145
153 /* We have a Gtk2::Frame on top of the stack */ 146 /* We have a Gtk2::Frame on top of the stack */
154 sv = POPs; 147 sv = POPs;
155 148
171 /* Sets up the Perl Stack for our call back into the script to run the 164 /* Sets up the Perl Stack for our call back into the script to run the
172 * plugin_pref... sub */ 165 * plugin_pref... sub */
173 int count; 166 int count;
174 PurplePerlScript *gps; 167 PurplePerlScript *gps;
175 PurplePluginPrefFrame *ret_frame; 168 PurplePluginPrefFrame *ret_frame;
176 STRLEN na;
177 dSP; 169 dSP;
178 170
179 gps = (PurplePerlScript *)plugin->info->extra_info; 171 gps = (PurplePerlScript *)plugin->info->extra_info;
180 172
181 ENTER; 173 ENTER;
190 SPAGAIN; 182 SPAGAIN;
191 183
192 if (SvTRUE(ERRSV)) { 184 if (SvTRUE(ERRSV)) {
193 purple_debug_error("perl", 185 purple_debug_error("perl",
194 "Perl plugin prefs frame init exited abnormally: %s\n", 186 "Perl plugin prefs frame init exited abnormally: %s\n",
195 SvPV(ERRSV, na)); 187 SvPVutf8_nolen(ERRSV));
196 } 188 }
197 189
198 if (count != 1) 190 if (count != 1)
199 croak("call_pv: Did not return the correct number of values.\n"); 191 croak("call_pv: Did not return the correct number of values.\n");
200 /* the frame was created in a perl sub and is returned */ 192 /* the frame was created in a perl sub and is returned */
247 static gboolean 239 static gboolean
248 perl_timeout_cb(gpointer data) 240 perl_timeout_cb(gpointer data)
249 { 241 {
250 PurplePerlTimeoutHandler *handler = data; 242 PurplePerlTimeoutHandler *handler = data;
251 gboolean ret = FALSE; 243 gboolean ret = FALSE;
252 STRLEN na;
253 244
254 dSP; 245 dSP;
255 ENTER; 246 ENTER;
256 SAVETMPS; 247 SAVETMPS;
257 PUSHMARK(sp); 248 PUSHMARK(sp);
261 SPAGAIN; 252 SPAGAIN;
262 253
263 if (SvTRUE(ERRSV)) { 254 if (SvTRUE(ERRSV)) {
264 purple_debug_error("perl", 255 purple_debug_error("perl",
265 "Perl timeout function exited abnormally: %s\n", 256 "Perl timeout function exited abnormally: %s\n",
266 SvPV(ERRSV, na)); 257 SvPVutf8_nolen(ERRSV));
267 } 258 }
268 259
269 ret = POPi; 260 ret = POPi;
270 261
271 PUTBACK; 262 PUTBACK;
289 int count; 280 int count;
290 int value_count; 281 int value_count;
291 PurpleValue *ret_value, **values; 282 PurpleValue *ret_value, **values;
292 SV **sv_args; 283 SV **sv_args;
293 DATATYPE **copy_args; 284 DATATYPE **copy_args;
294 STRLEN na;
295 285
296 dSP; 286 dSP;
297 ENTER; 287 ENTER;
298 SAVETMPS; 288 SAVETMPS;
299 PUSHMARK(sp); 289 PUSHMARK(sp);
332 } 322 }
333 323
334 if (SvTRUE(ERRSV)) { 324 if (SvTRUE(ERRSV)) {
335 purple_debug_error("perl", 325 purple_debug_error("perl",
336 "Perl function exited abnormally: %s\n", 326 "Perl function exited abnormally: %s\n",
337 SvPV(ERRSV, na)); 327 SvPVutf8_nolen(ERRSV));
338 } 328 }
339 329
340 /* See if any parameters changed. */ 330 /* See if any parameters changed. */
341 for (i = 0; i < value_count; i++) { 331 for (i = 0; i < value_count; i++) {
342 if (purple_value_is_outgoing(values[i])) { 332 if (purple_value_is_outgoing(values[i])) {
371 361
372 case PURPLE_TYPE_STRING: 362 case PURPLE_TYPE_STRING:
373 if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) { 363 if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) {
374 g_free(*((char **)copy_args[i])); 364 g_free(*((char **)copy_args[i]));
375 *((char **)copy_args[i]) = 365 *((char **)copy_args[i]) =
376 g_strdup(SvPV(sv_args[i], na)); 366 g_strdup(SvPVutf8_nolen(sv_args[i]));
377 } 367 }
368 /* Clean up sv_args[i] - we're done with it */
369 sv_2mortal(sv_args[i]);
378 break; 370 break;
379 371
380 case PURPLE_TYPE_POINTER: 372 case PURPLE_TYPE_POINTER:
381 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
382 break;
383
384 case PURPLE_TYPE_BOXED: 373 case PURPLE_TYPE_BOXED:
385 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); 374 *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
386 break; 375 break;
387 case PURPLE_TYPE_SUBTYPE: 376 case PURPLE_TYPE_SUBTYPE:
388 *((void **)copy_args[i]) = purple_perl_ref_object(sv_args[i]); 377 *((void **)copy_args[i]) = purple_perl_ref_object(sv_args[i]);
389 break; 378 break;
390 379
391 default: 380 default:
392 break; 381 break;
393 } 382 }
383
394 384
395 #if 0 385 #if 0
396 *((void **)copy_args[i]) = purple_perl_data_from_sv(values[i], 386 *((void **)copy_args[i]) = purple_perl_data_from_sv(values[i],
397 sv_args[i]); 387 sv_args[i]);
398 #endif 388 #endif
562 static PurpleCmdRet 552 static PurpleCmdRet
563 perl_cmd_cb(PurpleConversation *conv, const gchar *command, 553 perl_cmd_cb(PurpleConversation *conv, const gchar *command,
564 gchar **args, gchar **error, void *data) 554 gchar **args, gchar **error, void *data)
565 { 555 {
566 int i = 0, count, ret_value = PURPLE_CMD_RET_OK; 556 int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
567 STRLEN na;
568 SV *cmdSV, *tmpSV, *convSV; 557 SV *cmdSV, *tmpSV, *convSV;
569 PurplePerlCmdHandler *handler = data; 558 PurplePerlCmdHandler *handler = data;
570 559
571 dSP; 560 dSP;
572 ENTER; 561 ENTER;
602 croak("call_sv: Did not return the correct number of values.\n"); 591 croak("call_sv: Did not return the correct number of values.\n");
603 592
604 if (SvTRUE(ERRSV)) { 593 if (SvTRUE(ERRSV)) {
605 purple_debug_error("perl", 594 purple_debug_error("perl",
606 "Perl plugin command function exited abnormally: %s\n", 595 "Perl plugin command function exited abnormally: %s\n",
607 SvPV(ERRSV, na)); 596 SvPVutf8_nolen(ERRSV));
608 } 597 }
609 598
610 SPAGAIN; 599 SPAGAIN;
611 600
612 ret_value = POPi; 601 ret_value = POPi;
716 static void 705 static void
717 perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value, 706 perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value,
718 gpointer data) 707 gpointer data)
719 { 708 {
720 PurplePerlPrefsHandler *handler = data; 709 PurplePerlPrefsHandler *handler = data;
721 STRLEN na;
722 710
723 dSP; 711 dSP;
724 ENTER; 712 ENTER;
725 SAVETMPS; 713 SAVETMPS;
726 PUSHMARK(sp); 714 PUSHMARK(sp);
765 SPAGAIN; 753 SPAGAIN;
766 754
767 if (SvTRUE(ERRSV)) { 755 if (SvTRUE(ERRSV)) {
768 purple_debug_error("perl", 756 purple_debug_error("perl",
769 "Perl prefs callback function exited abnormally: %s\n", 757 "Perl prefs callback function exited abnormally: %s\n",
770 SvPV(ERRSV, na)); 758 SvPVutf8_nolen(ERRSV));
771 } 759 }
772 760
773 PUTBACK; 761 PUTBACK;
774 FREETMPS; 762 FREETMPS;
775 LEAVE; 763 LEAVE;

Mercurial Repository: pidgin3

mercurial