diff plugins/perl/perl.c @ 6636:452c62a92963

[gaim-migrate @ 7161] Say goodbye to perl namespace collision issues. committer: Tailor Script <[e-mail]>

--- a/plugins/perl/perl.c	Tue Aug 26 23:35:28 2003 +0000
+++ b/plugins/perl/perl.c	Wed Aug 27 04:50:25 2003 +0000
@@ -92,6 +92,7 @@
 typedef struct
 {
 	GaimPlugin *plugin;
+	char *package;
 	char *load_sub;
 	char *unload_sub;
 
@@ -111,7 +112,7 @@
 
 	/* This one allows dynamic loading of perl modules in perl
            scripts by the 'use perlmod;' construction*/
-	newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 }
 
 
@@ -130,7 +131,10 @@
 		   the file conents. This allows to have a realy local $/
 		   without introducing temp variables to hold the old
 		   value. Just a question of style:) */
-		"sub load_file{"
+		"package Gaim::PerlLoader;"
+		"use Symbol;"
+
+		"sub load_file {"
 		  "my $f_name=shift;"
 		  "local $/=undef;"
 		  "open FH,$f_name or return \"__FAILED__\";"
@@ -138,16 +142,28 @@
 		  "close FH;"
 		  "return $_;"
 		"}"
-		"sub load_n_eval{"
-		  "my $f_name=shift;"
+
+		"sub destroy_package {"
+		  "eval { $_[0]->UNLOAD() if $_[0]->can('UNLOAD'); };"
+		  "Symbol::delete_package($_[0]);"
+		"}"
+
+		"sub load_n_eval {"
+		  "my ($f_name, $package) = @_;"
+		  "destroy_package($package);"
 		  "my $strin=load_file($f_name);"
 		  "return 2 if($strin eq \"__FAILED__\");"
-		  "eval $strin;"
-		  "if($@){"
+		  "my $eval = qq{package $package; $strin;};"
+
+		  "{"
+		  "  eval $eval;"
+		  "}"
+
+		  "if($@) {"
 		    /*"  #something went wrong\n"*/
-		    "Gaim::debug(\"perl\", \"Errors loading file $f_name:\\n$@\");"
-		    "return 1;"
+		    "die(\"Errors loading file $f_name: $@\");"
 		  "}"
+
 		  "return 0;"
 		"}"
 	};
@@ -199,6 +215,23 @@
 	PUTBACK;
 }
 
+static void
+normalize_script_name(char *name)
+{
+	char *c;
+
+	c = strrchr(name, '.');
+
+	if (c != NULL)
+		*c = '\0';
+
+	for (c = name; *c != '\0'; c++)
+	{
+		if (*c == '_' && !g_ascii_isalnum(*c))
+			*c = '_';
+	}
+}
+
 static gboolean
 probe_perl_plugin(GaimPlugin *plugin)
 {
@@ -242,6 +275,7 @@
 		{
 			GaimPluginInfo *info;
 			GaimPerlScript *gps;
+			char *basename;
 			int len;
 
 			gaim_debug(GAIM_DEBUG_INFO, "perl", "Found plugin info\n");
@@ -257,6 +291,11 @@
 
 			gps->plugin = plugin;
 
+			basename = g_path_get_basename(plugin->path);
+			normalize_script_name(basename);
+			gps->package = g_strdup_printf("Gaim::Script::%s", basename);
+			g_free(basename);
+
 			/* We know this one exists. */
 			key = hv_fetch(plugin_info, "name", strlen("name"), 0);
 			info->name = g_strdup(SvPV(*key, len));
@@ -279,10 +318,12 @@
 				info->version = g_strdup(SvPV(*key, len));
 
 			if ((key = hv_fetch(plugin_info, "load", strlen("load"), 0)))
-				gps->load_sub = g_strdup(SvPV(*key, len));
+				gps->load_sub = g_strdup_printf("%s::%s", gps->package,
+												SvPV(*key, len));
 
 			if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0)))
-				gps->unload_sub = g_strdup(SvPV(*key, len));
+				gps->unload_sub = g_strdup_printf("%s::%s", gps->package,
+												  SvPV(*key, len));
 
 			plugin->info = info;
 			info->extra_info = gps;
@@ -301,7 +342,7 @@
 load_perl_plugin(GaimPlugin *plugin)
 {
 	GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info;
-	char *atmp[2] = { plugin->path, NULL };
+	char *atmp[3] = { plugin->path, NULL, NULL };
 
 	if (gps == NULL || gps->load_sub == NULL)
 		return FALSE;
@@ -311,9 +352,11 @@
 	if (my_perl == NULL)
 		perl_init();
 
-	plugin->handle = plugin->path;
+	plugin->handle = gps;
 
-	execute_perl("load_n_eval", 1, atmp);
+	atmp[1] = gps->package;
+
+	execute_perl("Gaim::PerlLoader::load_n_eval", 2, atmp);
 
 	{
 		dSP;
@@ -342,6 +385,28 @@
 	return TRUE;
 }
 
+static void
+destroy_package(const char *package)
+{
+	dSP;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(newSVpv(package, strlen(package))));
+	PUTBACK;
+
+	perl_call_pv("Gaim::PerlLoader::destroy_package",
+				 G_VOID | G_EVAL | G_DISCARD);
+
+	SPAGAIN;
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+}
+
 static gboolean
 unload_perl_plugin(GaimPlugin *plugin)
 {
@@ -371,7 +436,6 @@
 					   gps->load_sub, SvPV(ERRSV, len));
 		}
 
-
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
@@ -380,6 +444,8 @@
 	gaim_perl_signal_clear_for_plugin(plugin);
 	gaim_perl_timeout_clear_for_plugin(plugin);
 
+	destroy_package(gps->package);
+
 	return TRUE;
 }
 
@@ -418,6 +484,9 @@
 			if (gps->unload_sub != NULL)
 				g_free(gps->unload_sub);
 
+			if (gps->package != NULL)
+				g_free(gps->package);
+
 			g_free(gps);
 			plugin->info->extra_info = NULL;
 		}