Mercurial > pidgin3 / file comparison

comparison: plugins/perl/perl.c

plugins/perl/perl.c

changeset 11170
d8941580d87f
parent 11123
098f5c57f2bb
child 11256
fe82a0c5e5ec
equal deleted inserted replaced
11169:96612b706d45 11170:d8941580d87f
100 { 100 {
101 GaimPlugin *plugin; 101 GaimPlugin *plugin;
102 char *package; 102 char *package;
103 char *load_sub; 103 char *load_sub;
104 char *unload_sub; 104 char *unload_sub;
105
106 } GaimPerlScript; 105 } GaimPerlScript;
107 106
108 107
109 PerlInterpreter *my_perl = NULL; 108 PerlInterpreter *my_perl = NULL;
110 109
220 (*subaddr)(aTHX_ cv); 219 (*subaddr)(aTHX_ cv);
221 220
222 PUTBACK; 221 PUTBACK;
223 } 222 }
224 223
225 static void
226 normalize_script_name(char *name)
227 {
228 char *c;
229
230 c = strrchr(name, '.');
231
232 if (c != NULL)
233 *c = '\0';
234
235 for (c = name; *c != '\0'; c++)
236 {
237 if (*c != '_' && !g_ascii_isalnum(*c))
238 *c = '_';
239 }
240 }
241
242 static gboolean 224 static gboolean
243 probe_perl_plugin(GaimPlugin *plugin) 225 probe_perl_plugin(GaimPlugin *plugin)
244 { 226 {
245 /* XXX This would be much faster if I didn't create a new 227 /* XXX This would be much faster if I didn't create a new
246 * PerlInterpreter every time I probed a plugin */ 228 * PerlInterpreter every time I probed a plugin */
299 PERL_PLUGIN_ID); 281 PERL_PLUGIN_ID);
300 282
301 gps->plugin = plugin; 283 gps->plugin = plugin;
302 284
303 basename = g_path_get_basename(plugin->path); 285 basename = g_path_get_basename(plugin->path);
304 normalize_script_name(basename); 286 gaim_perl_normalize_script_name(basename);
305 gps->package = g_strdup_printf("Gaim::Script::%s", basename); 287 gps->package = g_strdup_printf("Gaim::Script::%s", basename);
306 g_free(basename); 288 g_free(basename);
307 289
308 /* We know this one exists. */ 290 /* We know this one exists. */
309 key = hv_fetch(plugin_info, "name", strlen("name"), 0); 291 key = hv_fetch(plugin_info, "name", strlen("name"), 0);
310 info->name = g_strdup(SvPV(*key, len)); 292 info->name = g_strdup(SvPV(*key, len));
311 293
294 if ((key = hv_fetch(plugin_info, "GTK_UI", strlen("GTK_UI"), 0)))
295 info->ui_requirement = GAIM_GTK_PLUGIN_TYPE;
296
312 if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) 297 if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0)))
313 info->homepage = g_strdup(SvPV(*key, len)); 298 info->homepage = g_strdup(SvPV(*key, len));
314 299
315 if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) 300 if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0)))
316 info->author = g_strdup(SvPV(*key, len)); 301 info->author = g_strdup(SvPV(*key, len));
317 302
318 if ((key = hv_fetch(plugin_info, "summary", 303 if ((key = hv_fetch(plugin_info, "summary",
319 strlen("summary"), 0))) 304 strlen("summary"), 0)))
332 317
333 if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0))) 318 if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0)))
334 gps->unload_sub = g_strdup_printf("%s::%s", gps->package, 319 gps->unload_sub = g_strdup_printf("%s::%s", gps->package,
335 SvPV(*key, len)); 320 SvPV(*key, len));
336 321
322 /********************************************************/
323 /* Only one of the next two options should be present */
324 /* */
325 /* prefs_info - Uses non-GUI (read GTK) gaim API calls */
326 /* and creates a GaimPluginPrefInfo type. */
327 /* */
328 /* gtk_prefs_info - Requires gtk2-perl be installed by */
329 /* the user and he must create a GtkWidget */
330 /* representing the plugin preferences */
331 /* page. */
332 /********************************************************/
337 if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) { 333 if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) {
338 /* key now is the name of the Perl sub that will create a frame for us */ 334 /* key now is the name of the Perl sub that will create a frame for us */
339 info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); 335 info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)));
340 } 336 }
337
338 if ((key = hv_fetch(plugin_info, "gtk_prefs_info", strlen("gtk_prefs_info"), 0))) {
339 /* key now is the name of the Perl sub that will create a frame for us */
340 info->ui_info = gaim_perl_gtk_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)));
341 }
342
343 /********************************************************/
344 /* */
345 /* plugin_action - This is given to the plugin info */
346 /* as the action GList. There are two parts */
347 /* so the user can set the title as it will appear */
348 /* in the plugin action menu. The name is */
349 /* extracted and then the callback perl sub's name */
350 /* both of which then are handled by an internal */
351 /* gaim_perl function that sets up the single cb */
352 /* function which is then inserted into 'info'. */
353 /********************************************************/
354 if ((key = hv_fetch(plugin_info, "plugin_action_label", strlen("plugin_action_label"), 0))) {
355 gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len));
356 }
357
358 if ((key = hv_fetch(plugin_info, "plugin_action", strlen("plugin_action"), 0))) {
359 gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len));
360 info->actions = gaim_perl_plugin_action;
361 }
341 362
342 plugin->info = info; 363 plugin->info = info;
343 info->extra_info = gps; 364 info->extra_info = gps;
344 365
345 status = gaim_plugin_register(plugin); 366 status = gaim_plugin_register(plugin);
346 } 367 }
347 } 368 }
348 369
349 perl_destruct(prober); 370 perl_destruct(prober);
350 perl_free(prober); 371 perl_free(prober);
351 372
352 return status; 373 return status;
353 } 374 }

Mercurial Repository: pidgin3

mercurial