src/perl.c

changeset 3563
ea2789c8077c
parent 3556
328d8598a916
child 3572
d07e14aa6f26
equal deleted inserted replaced
3562:1f6fd1bf0ebc 3563:ea2789c8077c
66 66
67 struct perlscript { 67 struct perlscript {
68 char *name; 68 char *name;
69 char *version; 69 char *version;
70 char *shutdowncallback; /* bleh */ 70 char *shutdowncallback; /* bleh */
71 struct gaim_plugin *plug;
71 }; 72 };
72 73
73 struct _perl_event_handlers { 74 struct _perl_event_handlers {
74 char *event_type; 75 char *event_type;
75 char *handler_name; 76 char *handler_name;
76 char *handle; 77 struct gaim_plugin *plug;
77 }; 78 };
78 79
79 struct _perl_timeout_handlers { 80 struct _perl_timeout_handlers {
80 char *handler_name; 81 char *handler_name;
81 char *handler_args; 82 char *handler_args;
82 gint iotag; 83 gint iotag;
83 char *handle; 84 struct gaim_plugin *plug;
84 }; 85 };
85 86
86 static GList *perl_list = NULL; /* should probably extern this at some point */ 87 static GList *perl_list = NULL; /* should probably extern this at some point */
87 static GList *perl_timeout_handlers = NULL; 88 static GList *perl_timeout_handlers = NULL;
88 static GList *perl_event_handlers = NULL; 89 static GList *perl_event_handlers = NULL;
201 202
202 return ret_value; 203 return ret_value;
203 204
204 } 205 }
205 206
206 /* This function is so incredibly broken and should never, ever, ever
207 be trusted to work */
208 void perl_unload_file(struct gaim_plugin *plug) { 207 void perl_unload_file(struct gaim_plugin *plug) {
209 struct perlscript *scp = NULL; 208 struct perlscript *scp = NULL;
210 struct _perl_timeout_handlers *thn; 209 struct _perl_timeout_handlers *thn;
211 struct _perl_event_handlers *ehn; 210 struct _perl_event_handlers *ehn;
212 211
213 GList *pl = perl_list; 212 GList *pl = perl_list;
214 213
215 debug_printf("Unloading %s\n", plug->handle); 214 debug_printf("Unloading %s\n", plug->handle);
216 while (pl) { 215 while (pl) {
217 scp = pl->data; 216 scp = pl->data;
218 /* This is so broken */ 217 if (scp->plug == plug) {
219 if (!strcmp(scp->name, plug->desc.name) && 218 perl_list = g_list_remove(perl_list, scp);
220 !strcmp(scp->version, plug->desc.version)) 219 if (scp->shutdowncallback[0])
220 execute_perl(scp->shutdowncallback, "");
221 perl_list = g_list_remove(perl_list, scp);
222 g_free(scp->name);
223 g_free(scp->version);
224 g_free(scp->shutdowncallback);
225 g_free(scp);
221 break; 226 break;
222 pl = pl->next; 227 }
223 scp = NULL;
224 }
225 if (scp) {
226 perl_list = g_list_remove(perl_list, scp);
227 if (scp->shutdowncallback[0])
228 execute_perl(scp->shutdowncallback, "");
229 perl_list = g_list_remove(perl_list, scp);
230 g_free(scp->name);
231 g_free(scp->version);
232 g_free(scp->shutdowncallback);
233 g_free(scp);
234 } 228 }
235 229
236 pl = perl_timeout_handlers; 230 pl = perl_timeout_handlers;
237 while (pl) { 231 while (pl) {
238 thn = pl->data; 232 thn = pl->data;
239 if (thn && thn->handle == plug->handle) { 233 if (thn && thn->plug == plug) {
240 g_list_remove(perl_timeout_handlers, thn); 234 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn);
241 g_source_remove(thn->iotag); 235 g_source_remove(thn->iotag);
242 g_free(thn->handler_args); 236 g_free(thn->handler_args);
243 g_free(thn->handler_name); 237 g_free(thn->handler_name);
244 g_free(thn); 238 g_free(thn);
245 } 239 }
247 } 241 }
248 242
249 pl = perl_event_handlers; 243 pl = perl_event_handlers;
250 while (pl) { 244 while (pl) {
251 ehn = pl->data; 245 ehn = pl->data;
252 if (ehn && ehn->handle == plug->handle) { 246 if (ehn && ehn->plug == plug) {
253 perl_event_handlers = g_list_remove(perl_event_handlers, ehn); 247 perl_event_handlers = g_list_remove(perl_event_handlers, ehn);
254 g_free(ehn->event_type); 248 g_free(ehn->event_type);
255 g_free(ehn->handler_name); 249 g_free(ehn->handler_name);
256 g_free(ehn); 250 g_free(ehn);
257 } 251 }
258 pl = pl->next; 252 pl = pl->next;
259 } 253 }
260 254
261 plug->handle=NULL; 255 plug->handle=NULL;
256 plugins = g_list_remove(plugins, plug);
257 save_prefs();
262 } 258 }
263 259
264 int perl_load_file(char *script_name) 260 int perl_load_file(char *script_name)
265 { 261 {
266 struct gaim_plugin *plug; 262 struct gaim_plugin *plug;
267 GList *p = probed_plugins; 263 GList *p = probed_plugins;
268 GList *e = perl_event_handlers; 264 GList *s;
269 GList *t = perl_timeout_handlers; 265 struct perlscript *scp;
270 int num_e, num_t, ret; 266 int ret;
271 267
272 if (my_perl == NULL) 268 if (my_perl == NULL)
273 perl_init(); 269 perl_init();
274 270
275 while (p) { 271 while (p) {
280 } 276 }
281 277
282 if (!plug) { 278 if (!plug) {
283 probe_perl(script_name); 279 probe_perl(script_name);
284 } 280 }
285 281
286 plug->handle = plug->path; 282 plug->handle = plug->path;
287 283 plugins = g_list_append(plugins, plug);
288 /* This is such a terrible hack-- if I weren't tired and annoyed
289 * with perl, I'm sure I wouldn't even be considering this. */
290 num_e=g_list_length(e);
291 num_t=g_list_length(t);
292 284
293 ret = execute_perl("load_n_eval", script_name); 285 ret = execute_perl("load_n_eval", script_name);
294 286
295 t = g_list_nth(perl_timeout_handlers, num_t++); 287 s = perl_list;
296 while (t) { 288 while (s) {
297 struct _perl_timeout_handlers *h = t->data; 289 scp = s->data;
298 h->handle = plug->handle; 290
299 t = t->next; 291 if (!strcmp(scp->name, plug->desc.name) &&
300 } 292 !strcmp(scp->version, plug->desc.version))
301 293 break;
302 e = g_list_nth(perl_event_handlers, num_e++); 294 s = s->next;
303 while (e) { 295 }
304 struct _perl_event_handlers *h = e->data; 296
305 h->handle = plug->handle; 297 if (!s) {
306 e = e->next; 298 g_snprintf(plug->error, sizeof(plug->error), _("GAIM::register not called with proper arguments. Consult PERL-HOWTO."));
307 } 299 return 0;
300 }
301
302 plug->error[0] = '\0';
308 return ret; 303 return ret;
309 } 304 }
310 305
311 struct gaim_plugin *probe_perl(const char *filename) { 306 struct gaim_plugin *probe_perl(const char *filename) {
312 307
313 /* XXX This woulld be much faster if I didn't create a new 308 /* XXX This woulld be much faster if I didn't create a new
314 * PerlInterpreter every time I did probed a plugin */ 309 * PerlInterpreter every time I probed a plugin */
315 310
316 PerlInterpreter *prober = perl_alloc(); 311 PerlInterpreter *prober = perl_alloc();
317 struct gaim_plugin * plug = NULL; 312 struct gaim_plugin * plug = NULL;
318 char *argv[] = {"", filename}; 313 char *argv[] = {"", filename};
319 int count; 314 int count;
326 SAVETMPS; 321 SAVETMPS;
327 PUSHMARK(SP); 322 PUSHMARK(SP);
328 323
329 count = perl_call_pv("description", G_NOARGS | G_ARRAY | G_EVAL); 324 count = perl_call_pv("description", G_NOARGS | G_ARRAY | G_EVAL);
330 SPAGAIN; 325 SPAGAIN;
331 debug_printf("desc: %d char: %d count: %d\n", sizeof(struct gaim_plugin_description), sizeof(char*), count);
332 if (count == (sizeof(struct gaim_plugin_description) - sizeof(int)) / sizeof(char*)) { 326 if (count == (sizeof(struct gaim_plugin_description) - sizeof(int)) / sizeof(char*)) {
333 plug = g_new0(struct gaim_plugin, 1); 327 plug = g_new0(struct gaim_plugin, 1);
334 plug->type = perl_script; 328 plug->type = perl_script;
335 g_snprintf(plug->path, sizeof(plug->path), filename); 329 g_snprintf(plug->path, sizeof(plug->path), filename);
336 plug->desc.iconfile = g_strdup(POPp); 330 plug->desc.iconfile = g_strdup(POPp);
447 XS (XS_GAIM_register) 441 XS (XS_GAIM_register)
448 { 442 {
449 char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */ 443 char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */
450 unsigned int junk; 444 unsigned int junk;
451 struct perlscript *scp; 445 struct perlscript *scp;
446 struct gaim_plugin *plug;
447 GList *pl = plugins;
448
452 dXSARGS; 449 dXSARGS;
453 items = 0; 450 items = 0;
454 451
455 name = SvPV (ST (0), junk); 452 name = SvPV (ST (0), junk);
456 ver = SvPV (ST (1), junk); 453 ver = SvPV (ST (1), junk);
457 callback = SvPV (ST (2), junk); 454 callback = SvPV (ST (2), junk);
458 unused = SvPV (ST (3), junk); 455 unused = SvPV (ST (3), junk);
459 456
460 scp = g_new0(struct perlscript, 1); 457 while (pl) {
461 scp->name = g_strdup(name); 458 plug = pl->data;
462 scp->version = g_strdup(ver); 459
463 scp->shutdowncallback = g_strdup(callback); 460 if (!strcmp(name, plug->desc.name) &&
464 perl_list = g_list_append(perl_list, scp); 461 !strcmp(ver, plug->desc.version)) {
465 462 break;
466 XST_mPV (0, VERSION); 463 }
464 pl = pl->next;
465 }
466
467 if (plug) {
468 scp = g_new0(struct perlscript, 1);
469 scp->name = g_strdup(name);
470 scp->version = g_strdup(ver);
471 scp->shutdowncallback = g_strdup(callback);
472 scp->plug = plug;
473 perl_list = g_list_append(perl_list, scp);
474 }
475 XST_mPV (0, plug->path);
467 XSRETURN (1); 476 XSRETURN (1);
468 } 477 }
469 478
470 XS (XS_GAIM_get_info) 479 XS (XS_GAIM_get_info)
471 { 480 {
961 970
962 XS (XS_GAIM_add_event_handler) 971 XS (XS_GAIM_add_event_handler)
963 { 972 {
964 unsigned int junk; 973 unsigned int junk;
965 struct _perl_event_handlers *handler; 974 struct _perl_event_handlers *handler;
966 dXSARGS; 975 char *handle;
967 items = 0; 976 struct gaim_plugin *plug;
968 977 GList *p = plugins;
969 handler = g_new0(struct _perl_event_handlers, 1); 978 dXSARGS;
970 handler->event_type = g_strdup(SvPV(ST(0), junk)); 979 items = 0;
971 handler->handler_name = g_strdup(SvPV(ST(1), junk)); 980
972 perl_event_handlers = g_list_append(perl_event_handlers, handler); 981 handle = SvPV(ST(0), junk);
973 debug_printf("registered perl event handler for %s\n", handler->event_type); 982 while (p) {
983 plug = p->data;
984 if (!strcmp(handle, plug->path))
985 break;
986 p = p->next;
987 }
988
989 if (p) {
990 handler = g_new0(struct _perl_event_handlers, 1);
991 handler->event_type = g_strdup(SvPV(ST(1), junk));
992 handler->handler_name = g_strdup(SvPV(ST(2), junk));
993 handler->plug = plug;
994 perl_event_handlers = g_list_append(perl_event_handlers, handler);
995 debug_printf("registered perl event handler for %s\n", handler->event_type);
996 } else {
997 debug_printf("Invalid handle (%s) registering perl event handler\n", handle);
998 }
999
974 XSRETURN_EMPTY; 1000 XSRETURN_EMPTY;
975 } 1001 }
976 1002
977 XS (XS_GAIM_remove_event_handler) 1003 XS (XS_GAIM_remove_event_handler)
978 { 1004 {
1013 XS (XS_GAIM_add_timeout_handler) 1039 XS (XS_GAIM_add_timeout_handler)
1014 { 1040 {
1015 unsigned int junk; 1041 unsigned int junk;
1016 long timeout; 1042 long timeout;
1017 struct _perl_timeout_handlers *handler; 1043 struct _perl_timeout_handlers *handler;
1018 dXSARGS; 1044 char *handle;
1019 items = 0; 1045 struct gaim_plugin *plug;
1020 1046 GList *p = plugins;
1021 handler = g_new0(struct _perl_timeout_handlers, 1); 1047
1022 timeout = 1000 * SvIV(ST(0)); 1048 dXSARGS;
1023 debug_printf("Adding timeout for %d seconds.\n", timeout/1000); 1049 items = 0;
1024 handler->handler_name = g_strdup(SvPV(ST(1), junk)); 1050
1025 handler->handler_args = g_strdup(SvPV(ST(2), junk)); 1051 handle = SvPV(ST(0), junk);
1026 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler); 1052 while (p) {
1027 handler->iotag = g_timeout_add(timeout, perl_timeout, handler); 1053 plug = p->data;
1054 if (!strcmp(handle, plug->path))
1055 break;
1056 p = p->next;
1057 }
1058
1059 if (p) {
1060 handler = g_new0(struct _perl_timeout_handlers, 1);
1061 timeout = 1000 * SvIV(ST(1));
1062 debug_printf("Adding timeout for %d seconds.\n", timeout/1000);
1063 handler->plug = plug;
1064 handler->handler_name = g_strdup(SvPV(ST(2), junk));
1065 handler->handler_args = g_strdup(SvPV(ST(3), junk));
1066 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler);
1067 handler->iotag = g_timeout_add(timeout, perl_timeout, handler);
1068 } else {
1069 debug_printf("Invalid handle (%s) in adding perl timeout handler.", handle);
1070 }
1028 XSRETURN_EMPTY; 1071 XSRETURN_EMPTY;
1029 } 1072 }
1030 1073
1031 XS (XS_GAIM_play_sound) 1074 XS (XS_GAIM_play_sound)
1032 { 1075 {
1044 { 1087 {
1045 perl_end(); 1088 perl_end();
1046 perl_init(); 1089 perl_init();
1047 } 1090 }
1048 1091
1049 extern void list_perl_scripts()
1050 {
1051 GList *s = perl_list;
1052 struct perlscript *p;
1053 char buf[BUF_LONG * 4];
1054 int at = 0;
1055
1056 at += g_snprintf(buf + at, sizeof(buf) - at, "Loaded scripts:\n");
1057 while (s) {
1058 p = (struct perlscript *)s->data;
1059 at += g_snprintf(buf + at, sizeof(buf) - at, "%s\n", p->name);
1060 s = s->next;
1061 }
1062
1063 do_error_dialog(buf, NULL, GAIM_INFO);
1064 }
1065 1092
1066 #endif /* USE_PERL */ 1093 #endif /* USE_PERL */

mercurial