diff options
| -rw-r--r-- | configure.in | 37 | ||||
| -rw-r--r-- | docs/manual.txt | 6 | ||||
| -rw-r--r-- | irssi.conf | 1 | ||||
| -rw-r--r-- | src/fe-common/core/completion.c | 51 | ||||
| -rw-r--r-- | src/fe-common/core/completion.h | 2 | ||||
| -rw-r--r-- | src/fe-common/irc/dcc/fe-dcc-send.c | 2 | ||||
| -rw-r--r-- | src/fe-text/Makefile.am | 7 | ||||
| -rw-r--r-- | src/fe-text/irssi.c | 5 | ||||
| -rw-r--r-- | src/perl/.cvsignore | 1 | ||||
| -rw-r--r-- | src/perl/Makefile.am | 49 | ||||
| -rw-r--r-- | src/perl/common/module.h | 9 | ||||
| -rw-r--r-- | src/perl/irssi-core.pl | 44 | ||||
| -rw-r--r-- | src/perl/module-formats.c | 41 | ||||
| -rw-r--r-- | src/perl/module-formats.h | 19 | ||||
| -rw-r--r-- | src/perl/module.h | 25 | ||||
| -rw-r--r-- | src/perl/perl-common.c | 5 | ||||
| -rw-r--r-- | src/perl/perl-common.h | 4 | ||||
| -rw-r--r-- | src/perl/perl-core.c | 355 | ||||
| -rw-r--r-- | src/perl/perl-core.h | 38 | ||||
| -rw-r--r-- | src/perl/perl-fe.c | 230 | ||||
| -rw-r--r-- | src/perl/perl-signals.c | 28 | ||||
| -rw-r--r-- | src/perl/perl-signals.h | 5 | ||||
| -rw-r--r-- | src/perl/perl-sources.c | 147 | ||||
| -rw-r--r-- | src/perl/perl-sources.h | 15 | ||||
| -rw-r--r-- | src/perl/perl.c | 411 | ||||
| -rw-r--r-- | src/perl/ui/UI.xs | 21 |
26 files changed, 1052 insertions, 506 deletions
diff --git a/configure.in b/configure.in index 75cf0c0e..8634f0f9 100644 --- a/configure.in +++ b/configure.in @@ -100,28 +100,28 @@ else PERL_LIB_DIR="$prefix" fi -AC_ARG_ENABLE(perl-path, -[ --enable-perl-path=dir Specify where to install the Perl libraries for irssi], - if test x$enableval = xyes; then +AC_ARG_WITH(perl-path, +[ --with-perl-path=dir Specify where to install the Perl libraries for irssi], + if test x$withval = xyes; then want_perl=yes else - if test "x$enableval" = xno; then + if test "x$withval" = xno; then want_perl=no else want_perl=yes - PERL_LIB_DIR="$enableval" + PERL_LIB_DIR="$withval" perl_lib_dir_given=yes fi fi, want_perl=yes) -AC_ARG_ENABLE(perl, -[ --enable-perl[=yes|no|static] Build with Perl support - also specifies - if it should be built into main irssi binary - (static) or as module (default)], - if test x$enableval = xyes; then +AC_ARG_WITH(perl, +[ --with-perl[=yes|no|static] Build with Perl support - also specifies + if it should be built into main irssi binary + (static) or as module (default)], + if test x$withval = xyes; then want_perl=yes - elif test x$enableval = xstatic; then + elif test x$withval = xstatic; then want_perl=static else want_perl=no @@ -542,26 +542,35 @@ if test "$want_perl" != "no"; then if test "x$want_perl" = "xstatic"; then dnl * building with static perl support dnl * all PERL_LDFLAGS linking is done in fe-text - PERL_LDFLAGS="../perl/libperl_static.la $PERL_LDFLAGS" - PERL_LINK_LIBS="$PERL_LDFLAGS" + PERL_LINK_FLAGS="$PERL_LDFLAGS" + PERL_LINK_LIBS="../perl/libperl_core_static.la" + PERL_FE_LINK_LIBS="../perl/libfe_perl_static.la" PERL_LDFLAGS= AC_DEFINE(HAVE_STATIC_PERL) dnl * build only static library of perl module perl_module_lib= - perl_static_lib=libperl_static.la + perl_module_fe_lib= + perl_static_lib=libperl_core_static.la + perl_static_fe_lib=libfe_perl_static.la PERL_LIBTOOL='$(SHELL) $(top_builddir)/libtool' else dnl * build dynamic library of perl module perl_module_lib=libperl_core.la + perl_module_fe_lib=libfe_perl.la perl_static_lib= + perl_static_fe_lib= PERL_LIBTOOL='$(SHELL) $(top_builddir)/libtool' fi AC_SUBST(perl_module_lib) AC_SUBST(perl_static_lib) + AC_SUBST(perl_module_fe_lib) + AC_SUBST(perl_static_fe_lib) AC_SUBST(PERL_LIBTOOL) + AC_SUBST(PERL_LINK_FLAGS) AC_SUBST(PERL_LINK_LIBS) + AC_SUBST(PERL_FE_LINK_LIBS) AC_SUBST(PERL_LDFLAGS) AC_SUBST(PERL_CFLAGS) diff --git a/docs/manual.txt b/docs/manual.txt index 7c25c7bc..f3c08273 100644 --- a/docs/manual.txt +++ b/docs/manual.txt @@ -146,10 +146,10 @@ --enable-memdebug Enable memory debugging, great for finding memory leaks - --enable-perl=static Build Perl support statically to irssi binary + --with-perl=static Build Perl support statically to irssi binary (default is to build a module) - --enable-perl-path=dir Specify installation dir for Perl libraries - --disable-perl Disable Perl support + --with-perl-path=dir Specify installation dir for Perl libraries + --without-perl Disable Perl support --with-socks Build with socks library --with-bot Build irssi-bot @@ -62,5 +62,6 @@ aliases = { SV = "say Irssi $J - http://irssi.org/"; GOTO = "sb goto"; CHAT = "dcc chat"; + RUN = "SCRIPT LOAD"; UPTIME = "eval exec - expr `date +%s` - \\$F | awk '{print \"Irssi uptime: \"int(\\\\\\$1/3600/24)\"d \"int(\\\\\\$1/3600%24)\"h \"int(\\\\\\$1/60%60)\"m \"int(\\\\\\$1%60)\"s\" }'"; }; 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 |