From a5b32b70a7db8ce41a37d9ee6fdef85300130351 Mon Sep 17 00:00:00 2001 From: Timo Sirainen Date: Sat, 20 Oct 2001 13:19:25 +0000 Subject: [PATCH] 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 | 4 +++- src/perl/common/Irssi.xs | 5 +++++ src/perl/irc/Irc.pm | 2 +- src/perl/irc/Irc.xs | 1 + src/perl/module.h | 4 ++++ src/perl/perl-core.c | 35 +++++++++++++++++++++++++++++++++-- src/perl/perl-core.h | 20 ++++++++++++++++++++ src/perl/perl-fe.c | 3 +++ src/perl/textui/TextUI.pm | 2 +- src/perl/textui/TextUI.xs | 1 + src/perl/ui/UI.pm | 2 +- src/perl/ui/UI.xs | 8 ++++++++ 12 files changed, 81 insertions(+), 6 deletions(-) diff --git a/src/perl/common/Irssi.pm b/src/perl/common/Irssi.pm index edb6aaff..17d463c4 100644 --- a/src/perl/common/Irssi.pm +++ b/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; diff --git a/src/perl/common/Irssi.xs b/src/perl/common/Irssi.xs index 272b27fd..59e4ebe6 100644 --- a/src/perl/common/Irssi.xs +++ b/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 diff --git a/src/perl/irc/Irc.pm b/src/perl/irc/Irc.pm index ee2d034a..48260a27 100644 --- a/src/perl/irc/Irc.pm +++ b/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; diff --git a/src/perl/irc/Irc.xs b/src/perl/irc/Irc.xs index 2fb835ac..306e3a4f 100644 --- a/src/perl/irc/Irc.xs +++ b/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"); diff --git a/src/perl/module.h b/src/perl/module.h index 0e95f13d..831ded91 100644 --- a/src/perl/module.h +++ b/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 diff --git a/src/perl/perl-core.c b/src/perl/perl-core.c index 914f6eff..d319be04 100644 --- a/src/perl/perl-core.c +++ b/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); diff --git a/src/perl/perl-core.h b/src/perl/perl-core.h index db607031..206ce818 100644 --- a/src/perl/perl-core.h +++ b/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); diff --git a/src/perl/perl-fe.c b/src/perl/perl-fe.c index 27ac154b..ee19c5a2 100644 --- a/src/perl/perl-fe.c +++ b/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); } diff --git a/src/perl/textui/TextUI.pm b/src/perl/textui/TextUI.pm index df7e8674..21f6d03b 100644 --- a/src/perl/textui/TextUI.pm +++ b/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; diff --git a/src/perl/textui/TextUI.xs b/src/perl/textui/TextUI.xs index 2fedc904..f3978212 100644 --- a/src/perl/textui/TextUI.xs +++ b/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); diff --git a/src/perl/ui/UI.pm b/src/perl/ui/UI.pm index 226d6953..7701d178 100644 --- a/src/perl/ui/UI.pm +++ b/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; diff --git a/src/perl/ui/UI.xs b/src/perl/ui/UI.xs index fc11c7ba..2e9dbeac 100644 --- a/src/perl/ui/UI.xs +++ b/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