Added API version check between perl module and perl libs.

perl_scripts_deinit() now destroys all dynamically loaded libraries (Irssi,
Irssi::Irc, Irssi::UI too) so /UNLOAD perl should now release more memory,
this also makes /unload perl, /load perl work again.


git-svn-id: http://svn.irssi.org/repos/irssi/trunk@1859 dbcabf3a-b0e7-0310-adc4-f8d773084564

src/perl/common/Irssi.pm

@@ -7,7 +7,7 @@ package Irssi;
 use strict;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-$VERSION = "0.20";
+$VERSION = "0.8";
 
 require Exporter;
 require DynaLoader;
@@ -29,5 +29,7 @@ bootstrap Irssi $VERSION;
 @Irssi::Channel::ISA = qw(Irssi::Windowitem);
 @Irssi::Query::ISA = qw(Irssi::Windowitem);
 
+Irssi::init();
+
 1;
 

src/perl/common/Irssi.xs

@@ -4,6 +4,11 @@ MODULE = Irssi  PACKAGE = Irssi
 
 PROTOTYPES: ENABLE
 
+void
+init()
+CODE:
+	perl_api_version_check("Irssi");
+
 INCLUDE: Channel.xs
 INCLUDE: Core.xs
 INCLUDE: Ignore.xs

src/perl/irc/Irc.pm

@@ -7,7 +7,7 @@ package Irssi::Irc;
 use strict;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-$VERSION = "0.20";
+$VERSION = "0.8";
 
 require Exporter;
 require DynaLoader;

src/perl/irc/Irc.xs

@@ -151,6 +151,7 @@ PREINIT:
 	int chat_type;
 CODE:
 	if (initialized) return;
+	perl_api_version_check("Irssi::Irc");
 	initialized = TRUE;
 
 	chat_type = chat_protocol_lookup("IRC");

src/perl/module.h

@@ -19,3 +19,7 @@ extern PerlInterpreter *my_perl; /* must be called my_perl or some perl implemen
 #include "common.h"
 
 #define MODULE_NAME "perl/core"
+
+/* Change this every time when some API changes between irssi's perl module
+   and irssi's perl libraries. */
+#define IRSSI_PERL_API_VERSION 20011020

src/perl/perl-core.c

@@ -41,6 +41,8 @@ extern void xs_init(void);
 GSList *perl_scripts;
 PerlInterpreter *my_perl;
 
+static int print_script_errors;
+
 #define IS_PERL_SCRIPT(file) \
 	(strlen(file) > 3 && strcmp(file+strlen(file)-3, ".pl") == 0)
 
@@ -112,9 +114,14 @@ void perl_scripts_deinit(void)
         while (perl_scripts != NULL)
 		perl_script_destroy(perl_scripts->data);
 
+        signal_emit("perl scripts deinit", 0);
+
         perl_signals_stop();
 	perl_sources_stop();
-        perl_common_stop();
+	perl_common_stop();
+
+        /* Unload all perl libraries loaded with dynaloader */
+	perl_eval_pv("foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); }", TRUE);
 
 	/* perl interpreter */
 	perl_destruct(my_perl);
@@ -320,6 +327,18 @@ char *perl_script_get_path(const char *name)
         return path;
 }
 
+/* If core should handle printing script errors */
+void perl_core_print_script_error(int print)
+{
+        print_script_errors = print;
+}
+
+/* Returns the perl module's API version. */
+int perl_get_api_version(void)
+{
+        return IRSSI_PERL_API_VERSION;
+}
+
 static void perl_scripts_autorun(void)
 {
 	DIR *dirp;
@@ -348,8 +367,18 @@ static void perl_scripts_autorun(void)
 	g_free(path);
 }
 
-static void sig_script_error(PERL_SCRIPT_REC *script)
+static void sig_script_error(PERL_SCRIPT_REC *script, const char *error)
 {
+	char *str;
+
+	if (print_script_errors) {
+		str = g_strdup_printf("Script '%s' error:",
+				      script == NULL ? "??" : script->name);
+		signal_emit("gui dialog", 2, "error", str);
+		signal_emit("gui dialog", 2, "error", error);
+                g_free(str);
+	}
+
 	if (script != NULL) {
 		perl_script_destroy(script);
                 signal_stop();
@@ -358,6 +387,8 @@ static void sig_script_error(PERL_SCRIPT_REC *script)
 
 void perl_core_init(void)
 {
+        print_script_errors = 1;
+
 	PL_perl_destruct_level = 1;
 	perl_signals_init();
         signal_add_last("script error", (SIGNAL_FUNC) sig_script_error);

src/perl/perl-core.h

@@ -32,6 +32,26 @@ PERL_SCRIPT_REC *perl_script_find_package(const char *package);
 /* Returns full path for the script */
 char *perl_script_get_path(const char *name);
 
+/* If core should handle printing script errors */
+void perl_core_print_script_error(int print);
+
+/* Returns the perl module's API version. */
+int perl_get_api_version(void);
+
+/* Checks that the API version is correct. */
+#define perl_api_version_check(library) \
+	if (perl_get_api_version() != IRSSI_PERL_API_VERSION) { \
+		char *str; \
+		str = g_strdup_printf("Version of perl module (%d) " \
+				      "doesn't match the version of " \
+				      library" library (%d)", \
+				      perl_get_api_version(), \
+				      IRSSI_PERL_API_VERSION); \
+		signal_emit("gui dialog", 2, "error", str); \
+		g_free(str); \
+		return; \
+        }
+
 void perl_core_init(void);
 void perl_core_deinit(void);
 

src/perl/perl-fe.c

@@ -232,6 +232,7 @@ void fe_perl_init(void)
 	signal_add("complete command script load", (SIGNAL_FUNC) sig_complete_load);
 	signal_add("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
 
+        perl_core_print_script_error(FALSE);
 	module_register("perl", "fe");
 }
 
@@ -247,4 +248,6 @@ void fe_perl_deinit(void)
         signal_remove("script error", (SIGNAL_FUNC) sig_script_error);
 	signal_remove("complete command script load", (SIGNAL_FUNC) sig_complete_load);
 	signal_remove("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
+
+        perl_core_print_script_error(TRUE);
 }

src/perl/textui/TextUI.pm

@@ -7,7 +7,7 @@ package Irssi::TextUI;
 use strict;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-$VERSION = "0.20";
+$VERSION = "0.8";
 
 require Exporter;
 require DynaLoader;

src/perl/textui/TextUI.xs

@@ -82,6 +82,7 @@ PREINIT:
 	static int initialized = FALSE;
 CODE:
 	if (initialized) return;
+	perl_api_version_check("Irssi::TextUI");
 	initialized = TRUE;
 
         irssi_add_plains(textui_plains);

src/perl/ui/UI.pm

@@ -7,7 +7,7 @@ package Irssi::UI;
 use strict;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-$VERSION = "0.20";
+$VERSION = "0.8";
 
 require Exporter;
 require DynaLoader;

src/perl/ui/UI.xs

@@ -104,6 +104,12 @@ static PLAIN_OBJECT_INIT_REC fe_plains[] = {
 	{ NULL, NULL }
 };
 
+static void sig_deinit(void)
+{
+	signal_remove("script destroy", (SIGNAL_FUNC) sig_script_destroy);
+	signal_remove("perl scripts deinit", (SIGNAL_FUNC) sig_deinit);
+}
+
 MODULE = Irssi::UI  PACKAGE = Irssi::UI
 
 PROTOTYPES: ENABLE
@@ -114,11 +120,13 @@ PREINIT:
 	static int initialized = FALSE;
 CODE:
 	if (initialized) return;
+	perl_api_version_check("Irssi::UI");
 	initialized = TRUE;
 
         irssi_add_plains(fe_plains);
 
 	signal_add("script destroy", (SIGNAL_FUNC) sig_script_destroy);
+	signal_add("perl scripts deinit", (SIGNAL_FUNC) sig_deinit);
 
 
 INCLUDE: Themes.xs