Added SILC Thread Queue API

[runtime.git] / apps / irssi / src / perl / perl-core.c

diff --git a/apps/irssi/src/perl/perl-core.c b/apps/irssi/src/perl/perl-core.c
index 1ed95c373fdfaf9492600686ce1005f4c5a05175..2b660eefa813405aa73cb1538f8214180ccc70e4 100644 (file)
--- a/apps/irssi/src/perl/perl-core.c
+++ b/apps/irssi/src/perl/perl-core.c
@@ -84,7 +84,7 @@ static void perl_script_destroy(PERL_SCRIPT_REC *script)
         g_free(script);
 }
 
-extern void boot_DynaLoader(CV* cv);
+extern void boot_DynaLoader(pTHX_ CV* cv);
 
 #if PERL_STATIC_LIBS == 1
 extern void boot_Irssi(CV *cv);
@@ -101,7 +101,7 @@ XS(boot_Irssi_Core)
 }
 #endif
 
-static void xs_init(void)
+static void xs_init(pTHX)
 {
        dXSUB_SYS;
 
@@ -160,7 +160,12 @@ void perl_scripts_deinit(void)
 
        /* Unload all perl libraries loaded with dynaloader */
        perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE);
-       perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);
+
+       /* We could unload all libraries .. but this crashes with some
+          libraries, probably because we don't call some deinit function..
+          Anyway, this would free some memory with /SCRIPT RESET, but it
+          leaks memory anyway. */
+       /*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/
 
        /* perl interpreter */
        perl_destruct(my_perl);
@@ -216,6 +221,7 @@ static int perl_script_eval(PERL_SCRIPT_REC *script)
        dSP;
        char *error;
        int retcount;
+       SV *ret;
 
        ENTER;
        SAVETMPS;
@@ -234,19 +240,19 @@ static int perl_script_eval(PERL_SCRIPT_REC *script)
 
         error = NULL;
        if (SvTRUE(ERRSV)) {
-                error = SvPV(ERRSV, PL_na);
-       } else if (retcount > 0) {
-               error = POPp;
-       }
+               error = SvPV(ERRSV, PL_na);
 
-       if (error != NULL) {
-               if (*error == '\0')
-                       error = NULL;
-               else {
-                        error = g_strdup(error);
+               if (error != NULL) {
+                       error = g_strdup(error);
                        signal_emit("script error", 2, script, error);
-                        g_free(error);
+                       g_free(error);
                }
+       } else if (retcount > 0) {
+               /* if script returns 0, it means the script wanted to die
+                  immediately without any error message */
+               ret = POPs;
+               if (ret != &PL_sv_undef && SvIOK(ret) && SvIV(ret) == 0)
+                       error = "";
        }
 
        PUTBACK;
@@ -367,11 +373,13 @@ char *perl_script_get_path(const char *name)
                /* check from SCRIPTDIR */
                g_free(path);
                path = g_strdup_printf(SCRIPTDIR"/%s", file);
-               if (stat(path, &statbuf) != 0)
-                        path = NULL;
+               if (stat(path, &statbuf) != 0) {
+                       g_free(path);
+                       path = NULL;
+               }
        }
        g_free(file);
-        return path;
+       return path;
 }
 
 /* If core should handle printing script errors */
@@ -444,7 +452,7 @@ void perl_core_init(void)
         print_script_errors = 1;
        settings_add_str("perl", "perl_use_lib", PERL_USE_LIB);
 
-       PL_perl_destruct_level = 1;
+       /*PL_perl_destruct_level = 1; - this crashes with some people.. */
        perl_signals_init();
         signal_add_last("script error", (SIGNAL_FUNC) sig_script_error);
 
@@ -462,8 +470,8 @@ void perl_core_init(void)
 
 void perl_core_deinit(void)
 {
-       perl_signals_deinit();
         perl_scripts_deinit();
+       perl_signals_deinit();
 
        signal_remove("script error", (SIGNAL_FUNC) sig_script_error);
 }