--enable-perl* -> --with-perl*. Added a new libfe_perl which handles /SCRIPT

commands. /RUN -> /SCRIPT LOAD, /PERLFLUSH -> /SCRIPT FLUSH, /PERL ->
/SCRIPT EXEC. Added /SCRIPT UNLOAD, /SCRIPT LIST. Lots of cleanups.

filename_complete() has extra argument for "default directory" which is
searched if no path is given when completing.


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

23 files changed, 1025 insertions, 489 deletions

diff --git a/src/fe-common/core/completion.c b/src/fe-common/core/completion.c
index c73b8d38..bc17feeb 100644
--- a/src/fe-common/core/completion.c
+++ b/src/fe-common/core/completion.c
@@ -208,7 +208,14 @@ char *word_complete(WINDOW_REC *window, const char *line, int *pos)
 	return ret;
 }
 
-GList *list_add_file(GList *list, const char *name)
+#define IS_CURRENT_DIR(dir) \
+        ((dir)[0] == '.' && ((dir)[1] == '\0' || (dir)[1] == G_DIR_SEPARATOR))
+
+#define USE_DEFAULT_PATH(path, default_path) \
+	((!g_path_is_absolute(path) || IS_CURRENT_DIR(path)) && \
+	 default_path != NULL)
+
+GList *list_add_file(GList *list, const char *name, const char *default_path)
 {
 	struct stat statbuf;
 	char *fname;
@@ -216,6 +223,11 @@ GList *list_add_file(GList *list, const char *name)
 	g_return_val_if_fail(name != NULL, NULL);
 
 	fname = convert_home(name);
+	if (USE_DEFAULT_PATH(fname, default_path)) {
+                g_free(fname);
+		fname = g_strconcat(default_path, G_DIR_SEPARATOR_S,
+				    name, NULL);
+	}
 	if (stat(fname, &statbuf) == 0) {
 		list = g_list_append(list, !S_ISDIR(statbuf.st_mode) ? g_strdup(name) :
 				     g_strconcat(name, G_DIR_SEPARATOR_S, NULL));
@@ -225,7 +237,7 @@ GList *list_add_file(GList *list, const char *name)
 	return list;
 }
 
-GList *filename_complete(const char *path)
+GList *filename_complete(const char *path, const char *default_path)
 {
         GList *list;
 	DIR *dirp;
@@ -239,17 +251,31 @@ GList *filename_complete(const char *path)
 
 	/* get directory part of the path - expand ~/ */
 	realpath = convert_home(path);
-	dir = g_dirname(realpath);
-	g_free(realpath);
+	if (USE_DEFAULT_PATH(realpath, default_path)) {
+                g_free(realpath);
+		realpath = g_strconcat(default_path, G_DIR_SEPARATOR_S,
+				       path, NULL);
+	}
 
 	/* open directory for reading */
+	dir = g_dirname(realpath);
 	dirp = opendir(dir);
 	g_free(dir);
-	if (dirp == NULL) return NULL;
+        g_free(realpath);
+
+	if (dirp == NULL)
+		return NULL;
 
 	dir = g_dirname(path);
-	if (*dir == G_DIR_SEPARATOR && dir[1] == '\0')
-		*dir = '\0'; /* completing file in root directory */
+	if (*dir == G_DIR_SEPARATOR && dir[1] == '\0') {
+                /* completing file in root directory */
+		*dir = '\0';
+	} else if (IS_CURRENT_DIR(dir) && !IS_CURRENT_DIR(path)) {
+		/* completing file in default_path
+		   (path not set, and leave it that way) */
+		g_free_and_null(dir);
+	}
+
 	basename = g_basename(path);
 	len = strlen(basename);
 
@@ -265,14 +291,15 @@ GList *filename_complete(const char *path)
 		}
 
 		if (len == 0 || strncmp(dp->d_name, basename, len) == 0) {
-			name = g_strdup_printf("%s"G_DIR_SEPARATOR_S"%s", dir, dp->d_name);
-			list = list_add_file(list, name);
+			name = dir == NULL ? g_strdup(dp->d_name) :
+				g_strdup_printf("%s"G_DIR_SEPARATOR_S"%s", dir, dp->d_name);
+			list = list_add_file(list, name, default_path);
 			g_free(name);
 		}
 	}
 	closedir(dirp);
 
-	g_free(dir);
+	g_free_not_null(dir);
         return list;
 }
 
@@ -617,7 +644,7 @@ static void sig_complete_filename(GList **list, WINDOW_REC *window,
 
 	if (*line != '\0') return;
 
-	*list = filename_complete(word);
+	*list = filename_complete(word, NULL);
 	if (*list != NULL) {
 		*want_space = FALSE;
 		signal_stop();
@@ -658,7 +685,6 @@ void completion_init(void)
 	signal_add("complete command set", (SIGNAL_FUNC) sig_complete_set);
 	signal_add("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle);
 	signal_add("complete command cat", (SIGNAL_FUNC) sig_complete_filename);
-	signal_add("complete command run", (SIGNAL_FUNC) sig_complete_filename);
 	signal_add("complete command save", (SIGNAL_FUNC) sig_complete_filename);
 	signal_add("complete command reload", (SIGNAL_FUNC) sig_complete_filename);
 	signal_add("complete command rawlog open", (SIGNAL_FUNC) sig_complete_filename);
@@ -676,7 +702,6 @@ void completion_deinit(void)
 	signal_remove("complete command set", (SIGNAL_FUNC) sig_complete_set);
 	signal_remove("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle);
 	signal_remove("complete command cat", (SIGNAL_FUNC) sig_complete_filename);
-	signal_remove("complete command run", (SIGNAL_FUNC) sig_complete_filename);
 	signal_remove("complete command save", (SIGNAL_FUNC) sig_complete_filename);
 	signal_remove("complete command reload", (SIGNAL_FUNC) sig_complete_filename);
 	signal_remove("complete command rawlog open", (SIGNAL_FUNC) sig_complete_filename);
diff --git a/src/fe-common/core/completion.h b/src/fe-common/core/completion.h
index ef0fe06f..35b1ea7c 100644
--- a/src/fe-common/core/completion.h
+++ b/src/fe-common/core/completion.h
@@ -8,7 +8,7 @@ char *auto_word_complete(const char *line, int *pos);
 /* manual word completion - called when TAB is pressed */
 char *word_complete(WINDOW_REC *window, const char *line, int *pos);
 
-GList *filename_complete(const char *path);
+GList *filename_complete(const char *path, const char *default_path);
 
 void completion_init(void);
 void completion_deinit(void);
diff --git a/src/fe-common/irc/dcc/fe-dcc-send.c b/src/fe-common/irc/dcc/fe-dcc-send.c
index 359e903c..3cf8b850 100644
--- a/src/fe-common/irc/dcc/fe-dcc-send.c
+++ b/src/fe-common/irc/dcc/fe-dcc-send.c
@@ -109,7 +109,7 @@ static void sig_dcc_send_complete(GList **list, WINDOW_REC *window,
 		return;
 
 	/* completing filename parameter for /DCC SEND */
-	*list = filename_complete(word);
+	*list = filename_complete(word, NULL);
 	if (*list != NULL) {
 		*want_space = FALSE;
 		signal_stop();
diff --git a/src/fe-text/Makefile.am b/src/fe-text/Makefile.am
index 87b97266..b3c43d48 100644
--- a/src/fe-text/Makefile.am
+++ b/src/fe-text/Makefile.am
@@ -10,11 +10,16 @@ INCLUDES = \
 	$(CURSES_INCLUDEDIR) \
 	-DLOCALEDIR=\""$(datadir)/locale"\"
 
-irssi_DEPENDENCIES = @COMMON_LIBS@
+irssi_DEPENDENCIES = \
+	@COMMON_LIBS@ \
+	@PERL_LINK_LIBS@ \
+	@PERL_FE_LINK_LIBS@
 
 irssi_LDADD = \
 	@COMMON_LIBS@ \
 	@PERL_LINK_LIBS@ \
+	@PERL_FE_LINK_LIBS@ \
+	@PERL_LINK_FLAGS@ \
 	$(PROG_LIBS) \
         $(CURSES_LIBS)
 
diff --git a/src/fe-text/irssi.c b/src/fe-text/irssi.c
index a2dc04a0..94fc18c2 100644
--- a/src/fe-text/irssi.c
+++ b/src/fe-text/irssi.c
@@ -45,6 +45,9 @@
 #ifdef HAVE_STATIC_PERL
 void perl_core_init(void);
 void perl_core_deinit(void);
+
+void fe_perl_init(void);
+void fe_perl_deinit(void);
 #endif
 
 void irc_init(void);
@@ -139,6 +142,7 @@ static void textui_finish_init(void)
 
 #ifdef HAVE_STATIC_PERL
 	perl_core_init();
+	fe_perl_init();
 #endif
 
 	if (display_firsttimer) {
@@ -178,6 +182,7 @@ static void textui_deinit(void)
 
 #ifdef HAVE_STATIC_PERL
         perl_core_deinit();
+        fe_perl_deinit();
 #endif
 
 	theme_unregister();
diff --git a/src/perl/.cvsignore b/src/perl/.cvsignore
index ecb47a34..189d2fd1 100644
--- a/src/perl/.cvsignore
+++ b/src/perl/.cvsignore
@@ -7,3 +7,4 @@ Makefile
 Makefile.in
 so_locations
 perl-signals-list.h
+irssi-core.pl.h
diff --git a/src/perl/Makefile.am b/src/perl/Makefile.am
index 14071459..21e40f2e 100644
--- a/src/perl/Makefile.am
+++ b/src/perl/Makefile.am
@@ -2,29 +2,43 @@ LIBTOOL = $(PERL_LIBTOOL)
 
 moduledir = $(libdir)/irssi/modules
 
-module_LTLIBRARIES = $(perl_module_lib)
-noinst_LTLIBRARIES = $(perl_static_lib)
+module_LTLIBRARIES = $(perl_module_lib) $(perl_module_fe_lib)
+noinst_LTLIBRARIES = $(perl_static_lib) $(perl_static_fe_lib)
 EXTRA_LTLIBRARIES = \
-	libperl_core.la \
-	libperl_static.la
+	libperl_core.la libfe_perl.la \
+	libperl_core_static.la libfe_perl_static.la
 
 libperl_core_la_LDFLAGS = -avoid-version -rpath $(moduledir)
+libfe_perl_la_LDFLAGS = -avoid-version -rpath $(moduledir)
 
-perl.c: perl-signals-list.h
+perl-core.c: perl-signals-list.h irssi-core.pl.h
 
 INCLUDES = $(GLIB_CFLAGS) \
 	-DSCRIPTDIR=\""$(libdir)/irssi/scripts"\" \
 	-DPERL_LIB_DIR=\""$(PERL_LIB_DIR)"\" \
 	$(PERL_CFLAGS) \
 	-I$(top_srcdir)/src \
-	-I$(top_srcdir)/src/core
+	-I$(top_srcdir)/src/core \
+	-I$(top_srcdir)/src/fe-common/core
 
 perl_sources = \
-	perl.c \
+	perl-core.c \
 	perl-common.c \
 	perl-signals.c \
+	perl-sources.c \
 	xsinit.c
 
+perl_fe_sources = \
+	module-formats.c \
+	perl-fe.c
+
+noinst_HEADERS = \
+	module.h \
+	perl-core.h \
+	perl-common.h \
+	perl-signals.h \
+	perl-sources.h
+
 libperl_core_la_DEPENDENCIES = .libs/libperl_orig.a .libs/DynaLoader.a
 
 .libs/libperl_orig.a:
@@ -39,12 +53,21 @@ libperl_core_la_DEPENDENCIES = .libs/libperl_orig.a .libs/DynaLoader.a
 libperl_core_la_SOURCES = \
 	$(perl_sources)
 
-libperl_static_la_SOURCES = \
+libperl_core_static_la_SOURCES = \
 	$(perl_sources)
 
+libfe_perl_la_SOURCES = \
+	$(perl_fe_sources)
+
+libfe_perl_static_la_SOURCES = \
+	$(perl_fe_sources)
+
 perl-signals-list.h: $(top_srcdir)/docs/signals.txt $(srcdir)/get-signals.pl
 	cat $(top_srcdir)/docs/signals.txt | $(perlpath) $(srcdir)/get-signals.pl > perl-signals-list.h
 
+irssi-core.pl.h: irssi-core.pl
+	$(top_srcdir)/file2header.sh $(srcdir)/irssi-core.pl irssi_core_code > irssi-core.pl.h
+
 CORE_SOURCES = \
 	common/Irssi.xs \
 	common/Irssi.pm \
@@ -88,15 +111,11 @@ EXTRA_DIST = \
 	libperl_dynaloader.la \
 	libperl_orig.la \
 	get-signals.pl \
+	irssi-core.pl \
 	$(CORE_SOURCES) \
 	$(IRC_SOURCES) \
 	$(UI_SOURCES)
 
-noinst_HEADERS = \
-	module.h \
-	perl-common.h \
-	perl-signals.h
-
 all-local:
 	for dir in common irc ui; do \
 	  cd $$dir && \
@@ -111,15 +130,13 @@ all-local:
 	  cd ..; \
 	done
 
-# FIXME: remove after .99: the libfe_perl must not be used anymore
 install-exec-local:
-	-(rm -f $(moduledir)/libfe_perl.*)
 	for dir in common irc ui; do \
 	  cd $$dir && $(MAKE) install && cd ..; \
 	done
 
 clean-generic:
-	rm -f common/Irssi.c irc/Irc.c ui/UI.c
+	rm -f common/Makefile irc/Makefile ui/Makefile
 
 distclean: distclean-am
 	-(cd common && $(MAKE) realclean && rm -f Makefile.PL)
diff --git a/src/perl/common/module.h b/src/perl/common/module.h
index 80d46b77..4920e1d0 100644
--- a/src/perl/common/module.h
+++ b/src/perl/common/module.h
@@ -1,11 +1,7 @@
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-#undef _
-#undef VERSION
+#define NEED_PERL_H
 #define HAVE_CONFIG_H
 #include "../module.h"
+#include <XSUB.h>
 
 #include "network.h"
 #include "levels.h"
@@ -27,6 +23,7 @@
 #include "queries.h"
 #include "nicklist.h"
 
+#include "perl/perl-core.h"
 #include "perl/perl-common.h"
 #include "perl/perl-signals.h"
 
diff --git a/src/perl/irssi-core.pl b/src/perl/irssi-core.pl
new file mode 100644
index 00000000..94517242
--- /dev/null
+++ b/src/perl/irssi-core.pl
@@ -0,0 +1,44 @@
+# NOTE: this is printed through printf()-like function,
+# so no extra percent characters.
+
+# %%s can be used once, it contains the
+# use Irssi; use Irssi::Irc; etc..
+package Irssi::Core;
+
+use Symbol qw(delete_package);
+use strict;
+
+sub destroy {
+  my $package = "Irssi::Script::".$_[0];
+  delete_package($package);
+}
+
+sub eval_data {
+  my ($data, $id) = @_;
+  destroy($id);
+
+  my $package = "Irssi::Script::$id";
+  my $eval = qq{package $package; %s sub handler { $data; }};
+  {
+      # hide our variables within this block
+      my ($filename, $package, $data);
+      eval $eval;
+  }
+  die $@ if $@;
+
+  eval {$package->handler;};
+  die $@ if $@;
+}
+
+sub eval_file {
+  my ($filename, $id) = @_;
+
+  local *FH;
+  open FH, $filename or die "File not found: $filename";
+  local($/) = undef;
+  my $data = <FH>;
+  close FH;
+  $/ = '\n';
+
+  eval_data($data, id);
+}
diff --git a/src/perl/module-formats.c b/src/perl/module-formats.c
new file mode 100644
index 00000000..d82e4554
--- /dev/null
+++ b/src/perl/module-formats.c
@@ -0,0 +1,41 @@
+/*
+ module-formats.c : irssi
+
+    Copyright (C) 2001 Timo Sirainen
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include "module.h"
+#include "formats.h"
+
+FORMAT_REC feperl_formats[] = {
+	{ MODULE_NAME, "Core", 0 },
+
+	/* ---- */
+	{ NULL, "Perl", 0 },
+
+	{ "script_not_found", "Script {hilight $0} not found", 1, { 0 } },
+	{ "script_not_loaded", "Script {hilight $0} is not loaded", 1, { 0 } },
+	{ "script_loaded", "Loaded script {hilight $0}", 2, { 0, 0 } },
+	{ "script_unloaded", "Unloaded script {hilight $0}", 1, { 0 } },
+	{ "no_scripts_loaded", "No scripts are loaded", 0 },
+	{ "script_list_header", "Loaded scripts:", 0 },
+	{ "script_list_line", "$[!15]0 $1", 2, { 0, 0 } },
+	{ "script_list_footer", "", 0 },
+	{ "script_error", "{error Error loading script {hilight $0}:}", 1, { 0 } },
+
+	{ NULL, NULL, 0 }
+};
diff --git a/src/perl/module-formats.h b/src/perl/module-formats.h
new file mode 100644
index 00000000..74d2e13b
--- /dev/null
+++ b/src/perl/module-formats.h
@@ -0,0 +1,19 @@
+#include "formats.h"
+
+enum {
+	IRCTXT_MODULE_NAME,
+
+	IRCTXT_FILL_1,
+
+        TXT_SCRIPT_NOT_FOUND,
+        TXT_SCRIPT_NOT_LOADED,
+        TXT_SCRIPT_LOADED,
+        TXT_SCRIPT_UNLOADED,
+        TXT_NO_SCRIPTS_LOADED,
+        TXT_SCRIPT_LIST_HEADER,
+        TXT_SCRIPT_LIST_LINE,
+        TXT_SCRIPT_LIST_FOOTER,
+        TXT_SCRIPT_ERROR
+};
+
+extern FORMAT_REC feperl_formats[];
diff --git a/src/perl/module.h b/src/perl/module.h
index 46fb4548..9c9f7399 100644
--- a/src/perl/module.h
+++ b/src/perl/module.h
@@ -1,20 +1,21 @@
-#include <EXTERN.h>
-#ifndef _SEM_SEMUN_UNDEFINED
-#define HAS_UNION_SEMUN
-#endif
-#include <perl.h>
+#ifdef NEED_PERL_H
+#  include <EXTERN.h>
+#  ifndef _SEM_SEMUN_UNDEFINED
+#    define HAS_UNION_SEMUN
+#  endif
+#  include <perl.h>
 
-#undef _
-#undef PACKAGE
+#  undef _
+#  undef PACKAGE
 
 /* For compatibility with perl 5.004 and older */
-#ifndef ERRSV
-#  define ERRSV GvSV(errgv)
+#  ifndef ERRSV
+#    define ERRSV GvSV(errgv)
+#  endif
+
+extern PerlInterpreter *my_perl; /* must be called my_perl or some perl implementations won't work */
 #endif
 
 #include "common.h"
 
 #define MODULE_NAME "irssi-perl"
-
-extern GSList *perl_scripts;
-extern PerlInterpreter *my_perl; /* must be called my_perl or some perl implementations won't work */
diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c
index 781cd9b8..dc3c3f0e 100644
--- a/src/perl/perl-common.c
+++ b/src/perl/perl-common.c
@@ -18,6 +18,7 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
+#define NEED_PERL_H
 #include "module.h"
 #include "modules.h"
 #include "signals.h"
@@ -513,7 +514,7 @@ static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec)
 				    GINT_TO_POINTER(rec->id));
 }
 
-void perl_common_init(void)
+void perl_common_start(void)
 {
 	static PLAIN_OBJECT_INIT_REC core_plains[] = {
 		{ "Irssi::Command", (PERL_OBJECT_FUNC) perl_command_fill_hash },
@@ -539,7 +540,7 @@ void perl_common_init(void)
 	signal_add("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol);
 }
 
-void perl_common_deinit(void)
+void perl_common_stop(void)
 {
         g_hash_table_foreach(iobject_stashes, (GHFunc) free_iobject_hash, NULL);
 	g_hash_table_destroy(iobject_stashes);
diff --git a/src/perl/perl-common.h b/src/perl/perl-common.h
index 26410ccd..81b4489d 100644
--- a/src/perl/perl-common.h
+++ b/src/perl/perl-common.h
@@ -46,7 +46,7 @@ void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects);
 
 char *perl_get_use_list(void);
 
-void perl_common_init(void);
-void perl_common_deinit(void);
+void perl_common_start(void);
+void perl_common_stop(void);
 
 #endif
diff --git a/src/perl/perl-core.c b/src/perl/perl-core.c
new file mode 100644
index 00000000..88be92e1
--- /dev/null
+++ b/src/perl/perl-core.c
@@ -0,0 +1,355 @@
+/*
+ perl-core.c : irssi
+
+    Copyright (C) 1999-2001 Timo Sirainen
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#define NEED_PERL_H
+#include "module.h"
+#include "signals.h"
+#include "misc.h"
+
+#include "perl-core.h"
+#include "perl-common.h"
+#include "perl-signals.h"
+#include "perl-sources.h"
+
+#include "irssi-core.pl.h"
+
+/* For compatibility with perl 5.004 and older */
+#ifndef HAVE_PL_PERL
+#  define PL_perl_destruct_level perl_destruct_level
+#endif
+
+extern void xs_init(void);
+
+GSList *perl_scripts;
+PerlInterpreter *my_perl;
+
+#define IS_PERL_SCRIPT(file) \
+	(strlen(file) > 3 && strcmp(file+strlen(file)-3, ".pl") == 0)
+
+static void perl_script_destroy_package(PERL_SCRIPT_REC *script)
+{
+	dSP;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(new_pv(script->package)));
+	PUTBACK;
+
+	perl_call_pv("Irssi::Core::destroy", G_VOID|G_EVAL|G_DISCARD);
+
+	SPAGAIN;
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+}
+
+static void perl_script_destroy(PERL_SCRIPT_REC *script)
+{
+        signal_emit("script destroyed", 1, script);
+
+        perl_signal_remove_package(script->package);
+	perl_source_remove_package(script->package);
+
+	g_free(script->name);
+	g_free(script->package);
+        g_free_not_null(script->path);
+        g_free_not_null(script->data);
+        g_free(script);
+
+	perl_scripts = g_slist_remove(perl_scripts, script);
+}
+
+/* Initialize perl interpreter */
+void perl_scripts_init(void)
+{
+	char *args[] = {"", "-e", "0"};
+	char *code, *use_code;
+
+	perl_scripts = NULL;
+        perl_sources_start();
+	perl_signals_start();
+
+	my_perl = perl_alloc();
+	perl_construct(my_perl);
+
+	perl_parse(my_perl, xs_init, 3, args, NULL);
+
+	use_code = perl_get_use_list();
+        code = g_strdup_printf(irssi_core_code, use_code);
+	perl_eval_pv(code, TRUE);
+
+	g_free(code);
+        g_free(use_code);
+
+        perl_common_start();
+}
+
+/* Destroy all perl scripts and deinitialize perl interpreter */
+void perl_scripts_deinit(void)
+{
+	/* destroy all scripts */
+        while (perl_scripts != NULL)
+		perl_script_destroy(perl_scripts->data);
+
+        perl_signals_stop();
+	perl_sources_stop();
+        perl_common_stop();
+
+	/* perl interpreter */
+	perl_destruct(my_perl);
+	perl_free(my_perl);
+	my_perl = NULL;
+}
+
+/* Unload perl script */
+void perl_script_unload(PERL_SCRIPT_REC *script)
+{
+        perl_script_destroy_package(script);
+        perl_script_destroy(script);
+}
+
+static char *script_file_get_name(const char *path)
+{
+	char *name, *ret, *p;
+
+        ret = name = g_strdup(g_basename(path));
+
+	p = strrchr(name, '.');
+	if (p != NULL) *p = '\0';
+
+	while (*name != '\0') {
+		if (*name != '_' && !isalnum(*name))
+			*name = '_';
+		name++;
+	}
+
+        return ret;
+}
+
+static char *script_data_get_name(void)
+{
+	GString *name;
+        char *ret;
+	int n;
+
+	name = g_string_new(NULL);
+        n = 1;
+	do {
+		g_string_sprintf(name, "data%d", n);
+                n++;
+	} while (perl_script_find(name->str) != NULL);
+
+	ret = name->str;
+        g_string_free(name, FALSE);
+        return ret;
+}
+
+static int perl_script_eval(PERL_SCRIPT_REC *script)
+{
+	dSP;
+	char *error;
+	int retcount;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(new_pv(script->path != NULL ? script->path :
+				 script->data)));
+	XPUSHs(sv_2mortal(new_pv(script->name)));
+	PUTBACK;
+
+	retcount = perl_call_pv(script->path != NULL ?
+				"Irssi::Core::eval_file" :
+				"Irssi::Core::eval_data",
+				G_EVAL|G_SCALAR);
+	SPAGAIN;
+
+        error = NULL;
+	if (SvTRUE(ERRSV)) {
+		STRLEN n_a;
+
+                error = SvPV(ERRSV, n_a);
+	} else if (retcount > 0) {
+		error = POPp;
+	}
+
+	if (error != NULL) {
+		if (*error == '\0')
+			error = NULL;
+		else
+			signal_emit("script error", 2, script, error);
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+        return error == NULL;
+}
+
+/* NOTE: name must not be free'd */
+static PERL_SCRIPT_REC *script_load(char *name, const char *path,
+				    const char *data)
+{
+        PERL_SCRIPT_REC *script;
+
+	/* if there's a script with a same name, destroy it */
+	script = perl_script_find(name);
+	if (script != NULL)
+		perl_script_destroy(script);
+
+	script = g_new0(PERL_SCRIPT_REC, 1);
+	script->name = name;
+	script->package = g_strdup_printf("Irssi::Script::%s", name);
+	script->path = g_strdup(path);
+        script->data = g_strdup(data);
+
+	perl_scripts = g_slist_append(perl_scripts, script);
+	signal_emit("script created", 1, script);
+
+	if (!perl_script_eval(script)) {
+		perl_script_unload(script);
+                script = NULL;
+	}
+        return script;
+}
+
+/* Load a perl script, path must be a full path. */
+PERL_SCRIPT_REC *perl_script_load_file(const char *path)
+{
+	char *name;
+
+        name = script_file_get_name(path);
+        return script_load(name, path, NULL);
+}
+
+/* Load a perl script from given data */
+PERL_SCRIPT_REC *perl_script_load_data(const char *data)
+{
+	char *name;
+
+	name = script_data_get_name();
+	return script_load(name, NULL, data);
+}
+
+/* Find loaded script by name */
+PERL_SCRIPT_REC *perl_script_find(const char *name)
+{
+	GSList *tmp;
+
+	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
+		PERL_SCRIPT_REC *rec = tmp->data;
+
+		if (strcmp(rec->name, name) == 0)
+                        return rec;
+	}
+
+        return NULL;
+}
+
+/* Find loaded script by package */
+PERL_SCRIPT_REC *perl_script_find_package(const char *package)
+{
+	GSList *tmp;
+
+	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
+		PERL_SCRIPT_REC *rec = tmp->data;
+
+		if (strcmp(rec->package, package) == 0)
+                        return rec;
+	}
+
+        return NULL;
+}
+
+/* Returns full path for the script */
+char *perl_script_get_path(const char *name)
+{
+	struct stat statbuf;
+	char *file, *path;
+
+	if (g_path_is_absolute(name) || (name[0] == '~' && name[1] == '/')) {
+		/* full path specified */
+                return convert_home(name);
+	}
+
+	/* add .pl suffix if it's missing */
+	file = IS_PERL_SCRIPT(name) ? g_strdup(name) :
+		g_strdup_printf("%s.pl", name);
+
+	/* check from ~/.irssi/scripts/ */
+	path = g_strdup_printf("%s/scripts/%s", get_irssi_dir(), file);
+	if (stat(path, &statbuf) != 0) {
+		/* check from SCRIPTDIR */
+		g_free(path);
+		path = g_strdup_printf(SCRIPTDIR"/%s", file);
+		if (stat(path, &statbuf) != 0)
+                        path = NULL;
+	}
+	g_free(file);
+        return path;
+}
+
+static void perl_scripts_autorun(void)
+{
+	DIR *dirp;
+	struct dirent *dp;
+	struct stat statbuf;
+	char *path, *fname;
+
+        /* run *.pl scripts from ~/.irssi/scripts/autorun/ */
+	path = g_strdup_printf("%s/scripts/autorun", get_irssi_dir());
+	dirp = opendir(path);
+	if (dirp == NULL) {
+		g_free(path);
+		return;
+	}
+
+	while ((dp = readdir(dirp)) != NULL) {
+		if (!IS_PERL_SCRIPT(dp->d_name))
+			continue;
+
+		fname = g_strdup_printf("%s/%s", path, dp->d_name);
+		if (stat(fname, &statbuf) == 0 && !S_ISDIR(statbuf.st_mode))
+			perl_script_load_file(fname);
+		g_free(fname);
+	}
+	closedir(dirp);
+	g_free(path);
+}
+
+void perl_core_init(void)
+{
+	PL_perl_destruct_level = 1;
+	perl_signals_init();
+
+	perl_scripts_init();
+	perl_scripts_autorun();
+}
+
+void perl_core_deinit(void)
+{
+	perl_signals_deinit();
+        perl_scripts_deinit();
+}
diff --git a/src/perl/perl-core.h b/src/perl/perl-core.h
new file mode 100644
index 00000000..db607031
--- /dev/null
+++ b/src/perl/perl-core.h
@@ -0,0 +1,38 @@
+#ifndef __PERL_CORE_H
+#define __PERL_CORE_H
+
+typedef struct {
+	char *name; /* unique name */
+        char *package; /* package name */
+
+        /* Script can be loaded from a file, or from some data in memory */
+	char *path; /* FILE: full path for file */
+	char *data; /* DATA: data used for the script */
+} PERL_SCRIPT_REC;
+
+extern GSList *perl_scripts;
+
+/* Initialize perl interpreter */
+void perl_scripts_init(void);
+/* Destroy all perl scripts and deinitialize perl interpreter */
+void perl_scripts_deinit(void);
+
+/* Load a perl script, path must be a full path. */
+PERL_SCRIPT_REC *perl_script_load_file(const char *path);
+/* Load a perl script from given data */
+PERL_SCRIPT_REC *perl_script_load_data(const char *data);
+/* Unload perl script */
+void perl_script_unload(PERL_SCRIPT_REC *script);
+
+/* Find loaded script by name */
+PERL_SCRIPT_REC *perl_script_find(const char *name);
+/* Find loaded script by package */
+PERL_SCRIPT_REC *perl_script_find_package(const char *package);
+
+/* Returns full path for the script */
+char *perl_script_get_path(const char *name);
+
+void perl_core_init(void);
+void perl_core_deinit(void);
+
+#endif
diff --git a/src/perl/perl-fe.c b/src/perl/perl-fe.c
new file mode 100644
index 00000000..7e00584c
--- /dev/null
+++ b/src/perl/perl-fe.c
@@ -0,0 +1,230 @@
+/*
+ perl-core.c : irssi
+
+    Copyright (C) 1999-2001 Timo Sirainen
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include "module.h"
+#include "module-formats.h"
+#include "signals.h"
+#include "commands.h"
+#include "levels.h"
+
+#include "printtext.h"
+#include "completion.h"
+
+#include "perl-core.h"
+
+static void cmd_script(const char *data, SERVER_REC *server, void *item)
+{
+	command_runsub("script", data, server, item);
+}
+
+static void cmd_script_exec(const char *data)
+{
+        PERL_SCRIPT_REC *script;
+	GHashTable *optlist;
+	char *code;
+	void *free_arg;
+
+	if (!cmd_get_params(data, &free_arg, 1 | PARAM_FLAG_OPTIONS,
+			    "script exec", &optlist, &code))
+		return;
+
+        if (*code == '\0')
+		cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
+
+        script = perl_script_load_data(code);
+	if (script != NULL &&
+	    g_hash_table_lookup(optlist, "permanent") == NULL) {
+		/* not a permanent script, unload immediately */
+                perl_script_unload(script);
+	}
+
+
+	cmd_params_free(free_arg);
+}
+
+static void cmd_script_load(const char *data)
+{
+        PERL_SCRIPT_REC *script;
+	char *fname;
+
+	fname = perl_script_get_path(data);
+	if (fname == NULL) {
+		printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
+                            TXT_SCRIPT_NOT_FOUND, data);
+		return;
+	}
+
+	script = perl_script_load_file(fname);
+	if (script != NULL) {
+		printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
+			    TXT_SCRIPT_LOADED, script->name, script->path);
+	}
+        g_free(fname);
+}
+
+static void cmd_script_unload(const char *data)
+{
+        PERL_SCRIPT_REC *script;
+
+	script = perl_script_find(data);
+	if (script == NULL) {
+		printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
+                            TXT_SCRIPT_NOT_LOADED, data);
+                return;
+	}
+
+	printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
+		    TXT_SCRIPT_UNLOADED, script->name);
+	perl_script_unload(script);
+}
+
+static void cmd_script_flush(const char *data)
+{
+	perl_scripts_deinit();
+	perl_scripts_init();
+}
+
+static void cmd_script_list(void)
+{
+	GSList *tmp;
+        GString *data;
+
+	if (perl_scripts == NULL) {
+		printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
+                            TXT_NO_SCRIPTS_LOADED);
+                return;
+	}
+
+	printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
+		    TXT_SCRIPT_LIST_HEADER);
+
+	data = g_string_new(NULL);
+	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
+		PERL_SCRIPT_REC *rec = tmp->data;
+
+                if (rec->path != NULL)
+			g_string_assign(data, rec->path);
+		else {
+			g_string_assign(data, rec->data);
+			if (data->len > 50) {
+				g_string_truncate(data, 50);
+                                g_string_append(data, " ...");
+			}
+		}
+
+		printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
+			    TXT_SCRIPT_LIST_LINE, rec->name, data->str);
+	}
+        g_string_free(data, TRUE);
+
+	printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
+		    TXT_SCRIPT_LIST_FOOTER);
+}
+
+static void sig_script_error(PERL_SCRIPT_REC *script, const char *error)
+{
+	printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
+                    TXT_SCRIPT_ERROR, script->name);
+
+	printtext(NULL, NULL, MSGLEVEL_CLIENTERROR, "%[-s]%s", error);
+}
+
+static void sig_complete_load(GList **list, WINDOW_REC *window,
+			      const char *word, const char *line,
+			      int *want_space)
+{
+        char *user_dir;
+
+	if (*line != '\0')
+		return;
+
+	/* completing filename parameter for /SCRIPT LOAD */
+	user_dir = g_strdup_printf("%s/scripts", get_irssi_dir());
+	*list = filename_complete(word, user_dir);
+	*list = g_list_concat(*list, filename_complete(word, SCRIPTDIR));
+        g_free(user_dir);
+
+	if (*list != NULL) {
+		*want_space = FALSE;
+		signal_stop();
+	}
+}
+
+static GList *script_complete(const char *name)
+{
+	GSList *tmp;
+        GList *list;
+        int len;
+
+        list = NULL;
+        len = strlen(name);
+	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
+		PERL_SCRIPT_REC *rec = tmp->data;
+
+		if (strncmp(rec->name, name, len) == 0)
+                        list = g_list_append(list, rec->name);
+	}
+
+        return list;
+}
+
+static void sig_complete_unload(GList **list, WINDOW_REC *window,
+				const char *word, const char *line,
+				int *want_space)
+{
+	if (*line != '\0')
+		return;
+
+	/* completing script parameter for /SCRIPT UNLOAD */
+	*list = script_complete(word);
+	if (*list != NULL)
+		signal_stop();
+}
+
+void fe_perl_init(void)
+{
+	theme_register(feperl_formats);
+
+	command_bind("script", NULL, (SIGNAL_FUNC) cmd_script);
+	command_bind("script exec", NULL, (SIGNAL_FUNC) cmd_script_exec);
+	command_bind("script load", NULL, (SIGNAL_FUNC) cmd_script_load);
+	command_bind("script unload", NULL, (SIGNAL_FUNC) cmd_script_unload);
+	command_bind("script flush", NULL, (SIGNAL_FUNC) cmd_script_flush);
+	command_bind("script list", NULL, (SIGNAL_FUNC) cmd_script_list);
+	command_set_options("script exec", "permanent");
+
+        signal_add("script error", (SIGNAL_FUNC) sig_script_error);
+	signal_add("complete command script load", (SIGNAL_FUNC) sig_complete_load);
+	signal_add("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
+}
+
+void fe_perl_deinit(void)
+{
+	command_unbind("script", (SIGNAL_FUNC) cmd_script);
+	command_unbind("script exec", (SIGNAL_FUNC) cmd_script_exec);
+	command_unbind("script load", (SIGNAL_FUNC) cmd_script_load);
+	command_unbind("script unload", (SIGNAL_FUNC) cmd_script_unload);
+	command_unbind("script flush", (SIGNAL_FUNC) cmd_script_flush);
+	command_unbind("script list", (SIGNAL_FUNC) cmd_script_list);
+
+        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);
+}
diff --git a/src/perl/perl-signals.c b/src/perl/perl-signals.c
index 2951d67c..520bbd60 100644
--- a/src/perl/perl-signals.c
+++ b/src/perl/perl-signals.c
@@ -1,9 +1,31 @@
+/*
+ perl-signals.c : irssi
+
+    Copyright (C) 1999-2001 Timo Sirainen
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#define NEED_PERL_H
 #include "module.h"
 #include "modules.h"
 #include "signals.h"
 #include "commands.h"
 #include "servers.h"
 
+#include "perl-core.h"
 #include "perl-common.h"
 #include "perl-signals.h"
 
@@ -136,7 +158,9 @@ static void perl_call_signal(const char *func, int signal_id,
 	if (SvTRUE(ERRSV)) {
 		STRLEN n_a;
 
-		signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
+		signal_emit("script error", 2,
+			    perl_script_find_package(perl_get_package()),
+			    SvPV(ERRSV, n_a));
 	}
 
         /* restore arguments the perl script modified */
@@ -379,7 +403,7 @@ static int signal_destroy_hash(void *key, GSList **list, const char *package)
 }
 
 /* destroy all signals used by package */
-void perl_signals_package_destroy(const char *package)
+void perl_signal_remove_package(const char *package)
 {
 	int n;
 
diff --git a/src/perl/perl-signals.h b/src/perl/perl-signals.h
index adea18a1..a4df2740 100644
--- a/src/perl/perl-signals.h
+++ b/src/perl/perl-signals.h
@@ -10,6 +10,8 @@ void perl_signal_add_to(const char *signal, const char *func, int priority);
         perl_signal_add_to(signal, func, 2)
 
 void perl_signal_remove(const char *signal, const char *func);
+/* remove all signals used by package */
+void perl_signal_remove_package(const char *package);
 
 void perl_command_bind_to(const char *cmd, const char *category,
 			  const char *func, int priority);
@@ -22,9 +24,6 @@ void perl_command_bind_to(const char *cmd, const char *category,
 
 void perl_command_unbind(const char *cmd, const char *func);
 
-/* destroy all signals used by package */
-void perl_signals_package_destroy(const char *package);
-
 void perl_signals_start(void);
 void perl_signals_stop(void);
 
diff --git a/src/perl/perl-sources.c b/src/perl/perl-sources.c
new file mode 100644
index 00000000..a16e87f9
--- /dev/null
+++ b/src/perl/perl-sources.c
@@ -0,0 +1,147 @@
+/*
+ perl-sources.c : irssi
+
+    Copyright (C) 1999-2001 Timo Sirainen
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#define NEED_PERL_H
+#include "module.h"
+#include "signals.h"
+
+#include "perl-core.h"
+#include "perl-common.h"
+
+typedef struct {
+	int tag;
+	char *func;
+	char *data;
+} PERL_SOURCE_REC;
+
+static GSList *perl_sources;
+
+static void perl_source_destroy(PERL_SOURCE_REC *rec)
+{
+	perl_sources = g_slist_remove(perl_sources, rec);
+
+	g_source_remove(rec->tag);
+	g_free(rec->func);
+	g_free(rec->data);
+	g_free(rec);
+}
+
+static int perl_source_event(PERL_SOURCE_REC *rec)
+{
+	dSP;
+	int retcount;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(new_pv(rec->data)));
+	PUTBACK;
+
+	retcount = perl_call_pv(rec->func, G_EVAL|G_DISCARD);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		STRLEN n_a;
+
+		signal_emit("script error", 2,
+			    perl_script_find_package(perl_get_package()),
+			    SvPV(ERRSV, n_a));
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	return 1;
+}
+
+int perl_timeout_add(int msecs, const char *func, const char *data)
+{
+	PERL_SOURCE_REC *rec;
+
+	rec = g_new(PERL_SOURCE_REC, 1);
+	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
+	rec->data = g_strdup(data);
+	rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
+
+	perl_sources = g_slist_append(perl_sources, rec);
+	return rec->tag;
+}
+
+int perl_input_add(int source, int condition,
+		   const char *func, const char *data)
+{
+	PERL_SOURCE_REC *rec;
+        GIOChannel *channel;
+
+	rec = g_new(PERL_SOURCE_REC, 1);
+	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
+	rec->data = g_strdup(data);
+
+        channel = g_io_channel_unix_new(source);
+	rec->tag = g_input_add(channel, condition,
+			       (GInputFunction) perl_source_event, rec);
+	g_io_channel_unref(channel);
+
+	perl_sources = g_slist_append(perl_sources, rec);
+	return rec->tag;
+}
+
+void perl_source_remove(int tag)
+{
+	GSList *tmp;
+
+	for (tmp = perl_sources; tmp != NULL; tmp = tmp->next) {
+		PERL_SOURCE_REC *rec = tmp->data;
+
+		if (rec->tag == tag) {
+			perl_source_destroy(rec);
+			break;
+		}
+	}
+}
+
+void perl_source_remove_package(const char *package)
+{
+	GSList *tmp, *next;
+        int len;
+
+        len = strlen(package);
+	for (tmp = perl_sources; tmp != NULL; tmp = next) {
+		PERL_SOURCE_REC *rec = tmp->data;
+
+		next = tmp->next;
+		if (strncmp(rec->func, package, len) == 0)
+			perl_source_destroy(rec);
+	}
+}
+
+void perl_sources_start(void)
+{
+	perl_sources = NULL;
+}
+
+void perl_sources_stop(void)
+{
+	/* timeouts and input waits */
+	while (perl_sources != NULL)
+		perl_source_destroy(perl_sources->data);
+}
diff --git a/src/perl/perl-sources.h b/src/perl/perl-sources.h
new file mode 100644
index 00000000..a04c4d80
--- /dev/null
+++ b/src/perl/perl-sources.h
@@ -0,0 +1,15 @@
+#ifndef __PERL_SOURCES_H
+#define __PERL_SOURCES_H
+
+int perl_timeout_add(int msecs, const char *func, const char *data);
+int perl_input_add(int source, int condition,
+		   const char *func, const char *data);
+
+void perl_source_remove(int tag);
+/* remove all sources used by package */
+void perl_source_remove_package(const char *package);
+
+void perl_sources_start(void);
+void perl_sources_stop(void);
+
+#endif
diff --git a/src/perl/perl.c b/src/perl/perl.c
deleted file mode 100644
index 6fe5d3b5..00000000
--- a/src/perl/perl.c
+++ /dev/null
@@ -1,411 +0,0 @@
-/*
- perl.c : irssi
-
-    Copyright (C) 1999-2001 Timo Sirainen
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-*/
-
-#include "module.h"
-#include "signals.h"
-#include "commands.h"
-#include "misc.h"
-
-#include "perl-common.h"
-#include "perl-signals.h"
-
-/* For compatibility with perl 5.004 and older */
-#ifndef HAVE_PL_PERL
-#  define PL_perl_destruct_level perl_destruct_level
-#endif
-
-extern void xs_init(void);
-
-typedef struct {
-	int tag;
-	char *func;
-	char *data;
-} PERL_SOURCE_REC;
-
-static GSList *perl_sources;
-GSList *perl_scripts;
-PerlInterpreter *my_perl;
-
-static void perl_source_destroy(PERL_SOURCE_REC *rec)
-{
-	perl_sources = g_slist_remove(perl_sources, rec);
-
-	g_source_remove(rec->tag);
-	g_free(rec->func);
-	g_free(rec->data);
-	g_free(rec);
-}
-
-static void irssi_perl_start(void)
-{
-	char *args[] = {"", "-e", "0"};
-	char eval_file_code[] =
-		"package Irssi::Load;\n"
-		"\n"
-		"use Symbol qw(delete_package);\n"
-		"\n"
-		"sub eval_file {\n"
-		"  my ($filename, $id) = @_;\n"
-		"  my $package = \"Irssi::Script::$id\";\n"
-		"  delete_package($package);\n"
-		"\n"
-		"  local *FH;\n"
-		"  open FH, $filename or die \"File not found: $filename\";\n"
-		"  local($/) = undef;\n"
-		"  my $sub = <FH>;\n"
-		"  close FH;\n"
-		"  $/ = '\n';\n"
-		"\n"
-		"  my $eval = qq{package $package; %s sub handler { $sub; }};\n"
-		"  {\n"
-		"      # hide our variables within this block\n"
-		"      my ($filename, $package, $sub);\n"
-		"      eval $eval;\n"
-		"  }\n"
-		"  die $@ if $@;\n"
-		"\n"
-		"  eval {$package->handler;};\n"
-		"  die $@ if $@;\n"
-		"}\n";
-	char *code, *use_code;
-
-        perl_signals_start();
-	perl_sources = NULL;
-
-	my_perl = perl_alloc();
-	perl_construct(my_perl);
-
-	perl_parse(my_perl, xs_init, 3, args, NULL);
-
-	use_code = perl_get_use_list();
-        code = g_strdup_printf(eval_file_code, use_code);
-	perl_eval_pv(code, TRUE);
-
-	g_free(code);
-        g_free(use_code);
-
-        perl_common_init();
-}
-
-static int perl_script_destroy(const char *name)
-{
-	GSList *tmp, *next, *item;
-	char *package;
-	int package_len;
-
-	item = gslist_find_string(perl_scripts, name);
-	if (item == NULL)
-		return FALSE;
-
-	package = g_strdup_printf("Irssi::Script::%s", name);
-	package_len = strlen(package);
-
-        signal_emit("script destroy", 3, "PERL", name, package);
-
-        perl_signals_package_destroy(package);
-
-	/* timeouts and input waits */
-	for (tmp = perl_sources; tmp != NULL; tmp = next) {
-		PERL_SOURCE_REC *rec = tmp->data;
-
-		next = tmp->next;
-		if (strncmp(rec->func, package, package_len) == 0)
-			perl_source_destroy(rec);
-	}
-
-	g_free(package);
-	g_free(item->data);
-	perl_scripts = g_slist_remove(perl_scripts, item->data);
-	return TRUE;
-}
-
-static void irssi_perl_stop(void)
-{
-        signal_emit("perl stop", 0);
-        perl_signals_stop();
-
-	/* timeouts and input waits */
-	while (perl_sources != NULL)
-		perl_source_destroy(perl_sources->data);
-
-	/* scripts list */
-	g_slist_foreach(perl_scripts, (GFunc) g_free, NULL);
-	g_slist_free(perl_scripts);
-	perl_scripts = NULL;
-
-	/* perl-common stuff */
-        perl_common_deinit();
-
-	/* perl interpreter */
-	perl_destruct(my_perl);
-	perl_free(my_perl);
-	my_perl = NULL;
-}
-
-static void script_fix_name(char *name)
-{
-	while (*name != '\0') {
-		if (*name != '_' && !isalnum(*name))
-			*name = '_';
-		name++;
-	}
-}
-
-static void cmd_run(const char *data)
-{
-	dSP;
-	struct stat statbuf;
-	char *fname, *name, *p;
-	int retcount;
-
-	if (g_path_is_absolute(data)) {
-		/* whole path specified */
-		fname = g_strdup(data);
-	} else {
-		/* add .pl suffix if it's missing */
-		name = (strlen(data) > 3 && strcmp(data+strlen(data)-3, ".pl") == 0) ?
-			g_strdup(data) : g_strdup_printf("%s.pl", data);
-
-		/* check from ~/.irssi/scripts/ */
-		fname = g_strdup_printf("%s/scripts/%s", get_irssi_dir(), name);
-		if (stat(fname, &statbuf) != 0) {
-			/* check from SCRIPTDIR */
-			g_free(fname),
-			fname = g_strdup_printf(SCRIPTDIR"/%s", name);
-		}
-		g_free(name);
-	}
-
-	/* get script name */
-	name = g_strdup(g_basename(fname));
-	p = strrchr(name, '.');
-	if (p != NULL) *p = '\0';
-
-	script_fix_name(name);
-	perl_script_destroy(name);
-
-	ENTER;
-	SAVETMPS;
-
-	PUSHMARK(SP);
-	XPUSHs(sv_2mortal(new_pv(fname))); g_free(fname);
-	XPUSHs(sv_2mortal(new_pv(name)));
-	PUTBACK;
-
-	retcount = perl_call_pv("Irssi::Load::eval_file",
-				G_EVAL|G_SCALAR);
-	SPAGAIN;
-
-	if (SvTRUE(ERRSV)) {
-		STRLEN n_a;
-
-		signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
-	}
-	else if (retcount > 0) {
-		char *str = POPp;
-
-		if (str != NULL && *str != '\0')
-			signal_emit("gui dialog", 2, "error", str);
-	}
-
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
-
-	perl_scripts = g_slist_append(perl_scripts, g_strdup(name));
-	signal_emit("script new", 2, "PERL", name);
-        g_free(name);
-}
-
-static void cmd_perl(const char *data)
-{
-	dSP;
-	GString *code;
-	char *uses;
-        SV *sv;
-
-	ENTER;
-	SAVETMPS;
-
-	PUSHMARK(SP);
-
-	code = g_string_new(NULL);
-
-	uses = perl_get_use_list();
-	g_string_sprintf(code, "sub { %s\n%s }", uses, data);
-
-	sv = perl_eval_pv(code->str, TRUE);
-	perl_call_sv(sv, G_VOID|G_NOARGS|G_EVAL|G_DISCARD);
-
-        g_free(uses);
-	g_string_free(code, TRUE);
-
-	SPAGAIN;
-
-	if (SvTRUE(ERRSV)) {
-		STRLEN n_a;
-
-		signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
-	}
-
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
-}
-
-static void cmd_unload(const char *data)
-{
-	char *name;
-
-	name = g_strdup(data);
-	script_fix_name(name);
-	if (perl_script_destroy(name))
-		signal_stop();
-	g_free(name);
-}
-
-static void cmd_perlflush(const char *data)
-{
-	irssi_perl_stop();
-	irssi_perl_start();
-}
-
-static int perl_source_event(PERL_SOURCE_REC *rec)
-{
-	dSP;
-	int retcount;
-
-	ENTER;
-	SAVETMPS;
-
-	PUSHMARK(SP);
-	XPUSHs(sv_2mortal(new_pv(rec->data)));
-	PUTBACK;
-
-	retcount = perl_call_pv(rec->func, G_EVAL|G_DISCARD);
-	SPAGAIN;
-
-	if (SvTRUE(ERRSV)) {
-		STRLEN n_a;
-
-		signal_emit("perl error", 1, SvPV(ERRSV, n_a));
-	}
-
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
-
-	return 1;
-}
-
-int perl_timeout_add(int msecs, const char *func, const char *data)
-{
-	PERL_SOURCE_REC *rec;
-
-	rec = g_new(PERL_SOURCE_REC, 1);
-	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
-	rec->data = g_strdup(data);
-	rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
-
-	perl_sources = g_slist_append(perl_sources, rec);
-	return rec->tag;
-}
-
-int perl_input_add(int source, int condition,
-		   const char *func, const char *data)
-{
-	PERL_SOURCE_REC *rec;
-        GIOChannel *channel;
-
-	rec = g_new(PERL_SOURCE_REC, 1);
-	rec->func = g_strdup_printf("%s::%s", perl_get_package(), func);
-	rec->data = g_strdup(data);
-
-        channel = g_io_channel_unix_new(source);
-	rec->tag = g_input_add(channel, condition,
-			       (GInputFunction) perl_source_event, rec);
-	g_io_channel_unref(channel);
-
-	perl_sources = g_slist_append(perl_sources, rec);
-	return rec->tag;
-}
-
-void perl_source_remove(int tag)
-{
-	GSList *tmp;
-
-	for (tmp = perl_sources; tmp != NULL; tmp = tmp->next) {
-		PERL_SOURCE_REC *rec = tmp->data;
-
-		if (rec->tag == tag) {
-			perl_source_destroy(rec);
-			break;
-		}
-	}
-}
-
-static void irssi_perl_autorun(void)
-{
-	DIR *dirp;
-	struct dirent *dp;
-	struct stat statbuf;
-	char *path, *fname;
-
-	path = g_strdup_printf("%s/scripts/autorun", get_irssi_dir());
-	dirp = opendir(path);
-	if (dirp == NULL) {
-		g_free(path);
-		return;
-	}
-
-	while ((dp = readdir(dirp)) != NULL) {
-		fname = g_strdup_printf("%s/%s", path, dp->d_name);
-                if (stat(fname, &statbuf) == 0 && !S_ISDIR(statbuf.st_mode))
-			cmd_run(fname);
-		g_free(fname);
-	}
-	closedir(dirp);
-	g_free(path);
-}
-
-void perl_core_init(void)
-{
-	perl_scripts = NULL;
-	command_bind("run", NULL, (SIGNAL_FUNC) cmd_run);
-	command_bind_first("unload", NULL, (SIGNAL_FUNC) cmd_unload);
-	command_bind("perl", NULL, (SIGNAL_FUNC) cmd_perl);
-	command_bind("perlflush", NULL, (SIGNAL_FUNC) cmd_perlflush);
-
-	PL_perl_destruct_level = 1;
-	perl_signals_init();
-	irssi_perl_start();
-	irssi_perl_autorun();
-}
-
-void perl_core_deinit(void)
-{
-	perl_signals_deinit();
-	irssi_perl_stop();
-
-	command_unbind("run", (SIGNAL_FUNC) cmd_run);
-	command_unbind("unload", (SIGNAL_FUNC) cmd_unload);
-	command_unbind("perl", (SIGNAL_FUNC) cmd_perl);
-	command_unbind("perlflush", (SIGNAL_FUNC) cmd_perlflush);
-}
diff --git a/src/perl/ui/UI.xs b/src/perl/ui/UI.xs
index d427dd07..fc11c7ba 100644
--- a/src/perl/ui/UI.xs
+++ b/src/perl/ui/UI.xs
@@ -91,25 +91,9 @@ static void perl_unregister_theme(const char *package)
 	theme_unregister_module(package);
 }
 
-static void sig_script_destroy(const char *type, const char *name,
-			       const char *package)
+static void sig_script_destroy(PERL_SCRIPT_REC *script)
 {
-	if (strcmp(type, "PERL") == 0)
-		perl_unregister_theme(package);
-}
-
-static void sig_perl_stop(void)
-{
-	GSList *tmp;
-        char *package;
-
-	/* themes */
-	for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
-		package = g_strdup_printf("Irssi::Script::%s",
-					  (char *) tmp->data);
-		perl_unregister_theme(package);
-		g_free(package);
-	}
+	perl_unregister_theme(script->package);
 }
 
 static PLAIN_OBJECT_INIT_REC fe_plains[] = {
@@ -135,7 +119,6 @@ CODE:
         irssi_add_plains(fe_plains);
 
 	signal_add("script destroy", (SIGNAL_FUNC) sig_script_destroy);
-	signal_add("perl stop", (SIGNAL_FUNC) sig_perl_stop);
 
 
 INCLUDE: Themes.xs