aniani/irssi
1
0
Fork 0
mirror of https://github.com/irssi/irssi.git synced 2024-12-04 14:46:39 -05:00
Code

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

Browse Source 
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
This commit is contained in:
Timo Sirainen 2001-07-29 09:17:53 +00:00 committed by cras
parent 2d5edb8c4d
commit 6c2f9c685a
26 changed files with 1052 additions and 506 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
configure.in
View File

@ -100,28 +100,28 @@ else
PERL_LIB_DIR="$prefix" PERL_LIB_DIR="$prefix"
fi fi
AC_ARG_ENABLE(perl-path, AC_ARG_WITH(perl-path,
[ --enable-perl-path=dir Specify where to install the Perl libraries for irssi], [ --with-perl-path=dir Specify where to install the Perl libraries for irssi],
if test x$enableval = xyes; then if test x$withval = xyes; then
want_perl=yes want_perl=yes
else else
if test "x$enableval" = xno; then if test "x$withval" = xno; then
want_perl=no want_perl=no
else else
want_perl=yes want_perl=yes
PERL_LIB_DIR="$enableval" PERL_LIB_DIR="$withval"
perl_lib_dir_given=yes perl_lib_dir_given=yes
fi fi
fi, fi,
want_perl=yes) want_perl=yes)
AC_ARG_ENABLE(perl, AC_ARG_WITH(perl,
[ --enable-perl[=yes|no|static] Build with Perl support - also specifies [ --with-perl[=yes|no|static] Build with Perl support - also specifies
if it should be built into main irssi binary if it should be built into main irssi binary
(static) or as module (default)], (static) or as module (default)],
if test x$enableval = xyes; then if test x$withval = xyes; then
want_perl=yes want_perl=yes
elif test x$enableval = xstatic; then elif test x$withval = xstatic; then
want_perl=static want_perl=static
else else
want_perl=no want_perl=no
@ -542,26 +542,35 @@ if test "$want_perl" != "no"; then
if test "x$want_perl" = "xstatic"; then if test "x$want_perl" = "xstatic"; then
dnl * building with static perl support dnl * building with static perl support
dnl * all PERL_LDFLAGS linking is done in fe-text dnl * all PERL_LDFLAGS linking is done in fe-text
PERL_LDFLAGS="../perl/libperl_static.la $PERL_LDFLAGS" PERL_LINK_FLAGS="$PERL_LDFLAGS"
PERL_LINK_LIBS="$PERL_LDFLAGS" PERL_LINK_LIBS="../perl/libperl_core_static.la"
PERL_FE_LINK_LIBS="../perl/libfe_perl_static.la"
PERL_LDFLAGS= PERL_LDFLAGS=
AC_DEFINE(HAVE_STATIC_PERL) AC_DEFINE(HAVE_STATIC_PERL)
dnl * build only static library of perl module dnl * build only static library of perl module
perl_module_lib= 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' PERL_LIBTOOL='$(SHELL) $(top_builddir)/libtool'
else else
dnl * build dynamic library of perl module dnl * build dynamic library of perl module
perl_module_lib=libperl_core.la perl_module_lib=libperl_core.la
perl_module_fe_lib=libfe_perl.la
perl_static_lib= perl_static_lib=
perl_static_fe_lib=
PERL_LIBTOOL='$(SHELL) $(top_builddir)/libtool' PERL_LIBTOOL='$(SHELL) $(top_builddir)/libtool'
fi fi
AC_SUBST(perl_module_lib) AC_SUBST(perl_module_lib)
AC_SUBST(perl_static_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_LIBTOOL)
AC_SUBST(PERL_LINK_FLAGS)
AC_SUBST(PERL_LINK_LIBS) AC_SUBST(PERL_LINK_LIBS)
AC_SUBST(PERL_FE_LINK_LIBS)
AC_SUBST(PERL_LDFLAGS) AC_SUBST(PERL_LDFLAGS)
AC_SUBST(PERL_CFLAGS) AC_SUBST(PERL_CFLAGS)

6
docs/manual.txt
View File

@ -146,10 +146,10 @@
--enable-memdebug Enable memory debugging, great for finding --enable-memdebug Enable memory debugging, great for finding
memory leaks 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) (default is to build a module)
--enable-perl-path=dir Specify installation dir for Perl libraries --with-perl-path=dir Specify installation dir for Perl libraries
--disable-perl Disable Perl support --without-perl Disable Perl support
--with-socks Build with socks library --with-socks Build with socks library
--with-bot Build irssi-bot --with-bot Build irssi-bot

1
irssi.conf
View File

@ -62,5 +62,6 @@ aliases = {
SV = "say Irssi $J - http://irssi.org/"; SV = "say Irssi $J - http://irssi.org/";
GOTO = "sb goto"; GOTO = "sb goto";
CHAT = "dcc chat"; 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\" }'"; 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\" }'";
}; };

49
src/fe-common/core/completion.c
View File

@ -208,7 +208,14 @@ char *word_complete(WINDOW_REC *window, const char *line, int *pos)
return ret; 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; struct stat statbuf;
char *fname; char *fname;
@ -216,6 +223,11 @@ GList *list_add_file(GList *list, const char *name)
g_return_val_if_fail(name != NULL, NULL); g_return_val_if_fail(name != NULL, NULL);
fname = convert_home(name); 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) { if (stat(fname, &statbuf) == 0) {
list = g_list_append(list, !S_ISDIR(statbuf.st_mode) ? g_strdup(name) : list = g_list_append(list, !S_ISDIR(statbuf.st_mode) ? g_strdup(name) :
g_strconcat(name, G_DIR_SEPARATOR_S, NULL)); g_strconcat(name, G_DIR_SEPARATOR_S, NULL));
@ -225,7 +237,7 @@ GList *list_add_file(GList *list, const char *name)
return list; return list;
} }
GList *filename_complete(const char *path) GList *filename_complete(const char *path, const char *default_path)
{ {
GList *list; GList *list;
DIR *dirp; DIR *dirp;
@ -239,17 +251,31 @@ GList *filename_complete(const char *path)
/* get directory part of the path - expand ~/ */ /* get directory part of the path - expand ~/ */
realpath = convert_home(path); realpath = convert_home(path);
dir = g_dirname(realpath); if (USE_DEFAULT_PATH(realpath, default_path)) {
g_free(realpath); g_free(realpath);
realpath = g_strconcat(default_path, G_DIR_SEPARATOR_S,
path, NULL);
}
/* open directory for reading */ /* open directory for reading */
dir = g_dirname(realpath);
dirp = opendir(dir); dirp = opendir(dir);
g_free(dir); g_free(dir);
if (dirp == NULL) return NULL; g_free(realpath);
if (dirp == NULL)
return NULL;
dir = g_dirname(path); dir = g_dirname(path);
if (*dir == G_DIR_SEPARATOR && dir[1] == '\0') if (*dir == G_DIR_SEPARATOR && dir[1] == '\0') {
*dir = '\0'; /* completing file in root directory */ /* 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); basename = g_basename(path);
len = strlen(basename); len = strlen(basename);
@ -265,14 +291,15 @@ GList *filename_complete(const char *path)
} }
if (len == 0 || strncmp(dp->d_name, basename, len) == 0) { if (len == 0 || strncmp(dp->d_name, basename, len) == 0) {
name = g_strdup_printf("%s"G_DIR_SEPARATOR_S"%s", dir, dp->d_name); name = dir == NULL ? g_strdup(dp->d_name) :
list = list_add_file(list, 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); g_free(name);
} }
} }
closedir(dirp); closedir(dirp);
g_free(dir); g_free_not_null(dir);
return list; return list;
} }
@ -617,7 +644,7 @@ static void sig_complete_filename(GList **list, WINDOW_REC *window,
if (*line != '\0') return; if (*line != '\0') return;
*list = filename_complete(word); *list = filename_complete(word, NULL);
if (*list != NULL) { if (*list != NULL) {
*want_space = FALSE; *want_space = FALSE;
signal_stop(); signal_stop();
@ -658,7 +685,6 @@ void completion_init(void)
signal_add("complete command set", (SIGNAL_FUNC) sig_complete_set); signal_add("complete command set", (SIGNAL_FUNC) sig_complete_set);
signal_add("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle); signal_add("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle);
signal_add("complete command cat", (SIGNAL_FUNC) sig_complete_filename); 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 save", (SIGNAL_FUNC) sig_complete_filename);
signal_add("complete command reload", (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); 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 set", (SIGNAL_FUNC) sig_complete_set);
signal_remove("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle); signal_remove("complete command toggle", (SIGNAL_FUNC) sig_complete_toggle);
signal_remove("complete command cat", (SIGNAL_FUNC) sig_complete_filename); 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 save", (SIGNAL_FUNC) sig_complete_filename);
signal_remove("complete command reload", (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); signal_remove("complete command rawlog open", (SIGNAL_FUNC) sig_complete_filename);

2
src/fe-common/core/completion.h
View File

@ -8,7 +8,7 @@ char *auto_word_complete(const char *line, int *pos);
/* manual word completion - called when TAB is pressed */ /* manual word completion - called when TAB is pressed */
char *word_complete(WINDOW_REC *window, const char *line, int *pos); 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_init(void);
void completion_deinit(void); void completion_deinit(void);

2
src/fe-common/irc/dcc/fe-dcc-send.c
View File

@ -109,7 +109,7 @@ static void sig_dcc_send_complete(GList **list, WINDOW_REC *window,
return; return;
/* completing filename parameter for /DCC SEND */ /* completing filename parameter for /DCC SEND */
*list = filename_complete(word); *list = filename_complete(word, NULL);
if (*list != NULL) { if (*list != NULL) {
*want_space = FALSE; *want_space = FALSE;
signal_stop(); signal_stop();

7
src/fe-text/Makefile.am
View File

@ -10,11 +10,16 @@ INCLUDES = \
$(CURSES_INCLUDEDIR) \ $(CURSES_INCLUDEDIR) \
-DLOCALEDIR=\""$(datadir)/locale"\" -DLOCALEDIR=\""$(datadir)/locale"\"
irssi_DEPENDENCIES = @COMMON_LIBS@ irssi_DEPENDENCIES = \
@COMMON_LIBS@ \
@PERL_LINK_LIBS@ \
@PERL_FE_LINK_LIBS@
irssi_LDADD = \ irssi_LDADD = \
@COMMON_LIBS@ \ @COMMON_LIBS@ \
@PERL_LINK_LIBS@ \ @PERL_LINK_LIBS@ \
@PERL_FE_LINK_LIBS@ \
@PERL_LINK_FLAGS@ \
$(PROG_LIBS) \ $(PROG_LIBS) \
$(CURSES_LIBS) $(CURSES_LIBS)

5
src/fe-text/irssi.c
View File

@ -45,6 +45,9 @@
#ifdef HAVE_STATIC_PERL #ifdef HAVE_STATIC_PERL
void perl_core_init(void); void perl_core_init(void);
void perl_core_deinit(void); void perl_core_deinit(void);
void fe_perl_init(void);
void fe_perl_deinit(void);
#endif #endif
void irc_init(void); void irc_init(void);
@ -139,6 +142,7 @@ static void textui_finish_init(void)
#ifdef HAVE_STATIC_PERL #ifdef HAVE_STATIC_PERL
perl_core_init(); perl_core_init();
fe_perl_init();
#endif #endif
if (display_firsttimer) { if (display_firsttimer) {
@ -178,6 +182,7 @@ static void textui_deinit(void)
#ifdef HAVE_STATIC_PERL #ifdef HAVE_STATIC_PERL
perl_core_deinit(); perl_core_deinit();
fe_perl_deinit();
#endif #endif
theme_unregister(); theme_unregister();

1
src/perl/.cvsignore
View File

@ -7,3 +7,4 @@ Makefile
Makefile.in Makefile.in
so_locations so_locations
perl-signals-list.h perl-signals-list.h
irssi-core.pl.h

49
src/perl/Makefile.am
View File

@ -2,29 +2,43 @@ LIBTOOL = $(PERL_LIBTOOL)
moduledir = $(libdir)/irssi/modules moduledir = $(libdir)/irssi/modules
module_LTLIBRARIES = $(perl_module_lib) module_LTLIBRARIES = $(perl_module_lib) $(perl_module_fe_lib)
noinst_LTLIBRARIES = $(perl_static_lib) noinst_LTLIBRARIES = $(perl_static_lib) $(perl_static_fe_lib)
EXTRA_LTLIBRARIES = \ EXTRA_LTLIBRARIES = \
libperl_core.la \ libperl_core.la libfe_perl.la \
libperl_static.la libperl_core_static.la libfe_perl_static.la
libperl_core_la_LDFLAGS = -avoid-version -rpath $(moduledir) 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) \ INCLUDES = $(GLIB_CFLAGS) \
-DSCRIPTDIR=\""$(libdir)/irssi/scripts"\" \ -DSCRIPTDIR=\""$(libdir)/irssi/scripts"\" \
-DPERL_LIB_DIR=\""$(PERL_LIB_DIR)"\" \ -DPERL_LIB_DIR=\""$(PERL_LIB_DIR)"\" \
$(PERL_CFLAGS) \ $(PERL_CFLAGS) \
-I$(top_srcdir)/src \ -I$(top_srcdir)/src \
-I$(top_srcdir)/src/core -I$(top_srcdir)/src/core \
-I$(top_srcdir)/src/fe-common/core
perl_sources = \ perl_sources = \
perl.c \ perl-core.c \
perl-common.c \ perl-common.c \
perl-signals.c \ perl-signals.c \
perl-sources.c \
xsinit.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 libperl_core_la_DEPENDENCIES = .libs/libperl_orig.a .libs/DynaLoader.a
.libs/libperl_orig.a: .libs/libperl_orig.a:
@ -39,12 +53,21 @@ libperl_core_la_DEPENDENCIES = .libs/libperl_orig.a .libs/DynaLoader.a
libperl_core_la_SOURCES = \ libperl_core_la_SOURCES = \
$(perl_sources) $(perl_sources)
libperl_static_la_SOURCES = \ libperl_core_static_la_SOURCES = \
$(perl_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 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 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 = \ CORE_SOURCES = \
common/Irssi.xs \ common/Irssi.xs \
common/Irssi.pm \ common/Irssi.pm \
@ -88,15 +111,11 @@ EXTRA_DIST = \
libperl_dynaloader.la \ libperl_dynaloader.la \
libperl_orig.la \ libperl_orig.la \
get-signals.pl \ get-signals.pl \
irssi-core.pl \
$(CORE_SOURCES) \ $(CORE_SOURCES) \
$(IRC_SOURCES) \ $(IRC_SOURCES) \
$(UI_SOURCES) $(UI_SOURCES)
noinst_HEADERS = \
module.h \
perl-common.h \
perl-signals.h
all-local: all-local:
for dir in common irc ui; do \ for dir in common irc ui; do \
cd $$dir && \ cd $$dir && \
@ -111,15 +130,13 @@ all-local:
cd ..; \ cd ..; \
done done
# FIXME: remove after .99: the libfe_perl must not be used anymore
install-exec-local: install-exec-local:
-(rm -f $(moduledir)/libfe_perl.*)
for dir in common irc ui; do \ for dir in common irc ui; do \
cd $$dir && $(MAKE) install && cd ..; \ cd $$dir && $(MAKE) install && cd ..; \
done done
clean-generic: clean-generic:
rm -f common/Irssi.c irc/Irc.c ui/UI.c rm -f common/Makefile irc/Makefile ui/Makefile
distclean: distclean-am distclean: distclean-am
-(cd common && $(MAKE) realclean && rm -f Makefile.PL) -(cd common && $(MAKE) realclean && rm -f Makefile.PL)

9
src/perl/common/module.h
View File

@ -1,11 +1,7 @@
#include <EXTERN.h> #define NEED_PERL_H
#include <perl.h>
#include <XSUB.h>
#undef _
#undef VERSION
#define HAVE_CONFIG_H #define HAVE_CONFIG_H
#include "../module.h" #include "../module.h"
#include <XSUB.h>
#include "network.h" #include "network.h"
#include "levels.h" #include "levels.h"
@ -27,6 +23,7 @@
#include "queries.h" #include "queries.h"
#include "nicklist.h" #include "nicklist.h"
#include "perl/perl-core.h"
#include "perl/perl-common.h" #include "perl/perl-common.h"
#include "perl/perl-signals.h" #include "perl/perl-signals.h"

44
src/perl/irssi-core.pl Normal file
View File

@ -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);
}

41
src/perl/module-formats.c Normal file
View File

@ -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 }
};

19
src/perl/module-formats.h Normal file
View File

@ -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[];

7
src/perl/module.h
View File

@ -1,3 +1,4 @@
#ifdef NEED_PERL_H
# include <EXTERN.h> # include <EXTERN.h>
# ifndef _SEM_SEMUN_UNDEFINED # ifndef _SEM_SEMUN_UNDEFINED
# define HAS_UNION_SEMUN # define HAS_UNION_SEMUN
@ -12,9 +13,9 @@
# define ERRSV GvSV(errgv) # define ERRSV GvSV(errgv)
# endif # endif
extern PerlInterpreter *my_perl; /* must be called my_perl or some perl implementations won't work */
#endif
#include "common.h" #include "common.h"
#define MODULE_NAME "irssi-perl" #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 */

5
src/perl/perl-common.c
View File

@ -18,6 +18,7 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/ */
#define NEED_PERL_H
#include "module.h" #include "module.h"
#include "modules.h" #include "modules.h"
#include "signals.h" #include "signals.h"
@ -513,7 +514,7 @@ static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec)
GINT_TO_POINTER(rec->id)); GINT_TO_POINTER(rec->id));
} }
void perl_common_init(void) void perl_common_start(void)
{ {
static PLAIN_OBJECT_INIT_REC core_plains[] = { static PLAIN_OBJECT_INIT_REC core_plains[] = {
{ "Irssi::Command", (PERL_OBJECT_FUNC) perl_command_fill_hash }, { "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); 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_foreach(iobject_stashes, (GHFunc) free_iobject_hash, NULL);
g_hash_table_destroy(iobject_stashes); g_hash_table_destroy(iobject_stashes);

4
src/perl/perl-common.h
View File

@ -46,7 +46,7 @@ void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects);
char *perl_get_use_list(void); char *perl_get_use_list(void);
void perl_common_init(void); void perl_common_start(void);
void perl_common_deinit(void); void perl_common_stop(void);
#endif #endif

355
src/perl/perl-core.c Normal file
View File

@ -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();
}

38
src/perl/perl-core.h Normal file
View File

@ -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

230
src/perl/perl-fe.c Normal file
View File

@ -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);
}

28
src/perl/perl-signals.c
View File

@ -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 "module.h"
#include "modules.h" #include "modules.h"
#include "signals.h" #include "signals.h"
#include "commands.h" #include "commands.h"
#include "servers.h" #include "servers.h"
#include "perl-core.h"
#include "perl-common.h" #include "perl-common.h"
#include "perl-signals.h" #include "perl-signals.h"
@ -136,7 +158,9 @@ static void perl_call_signal(const char *func, int signal_id,
if (SvTRUE(ERRSV)) { if (SvTRUE(ERRSV)) {
STRLEN n_a; 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 */ /* 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 */ /* destroy all signals used by package */
void perl_signals_package_destroy(const char *package) void perl_signal_remove_package(const char *package)
{ {
int n; int n;

5
src/perl/perl-signals.h
View File

@ -10,6 +10,8 @@ void perl_signal_add_to(const char *signal, const char *func, int priority);
perl_signal_add_to(signal, func, 2) perl_signal_add_to(signal, func, 2)
void perl_signal_remove(const char *signal, const char *func); 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, void perl_command_bind_to(const char *cmd, const char *category,
const char *func, int priority); 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); 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_start(void);
void perl_signals_stop(void); void perl_signals_stop(void);

147
src/perl/perl-sources.c Normal file
View File

@ -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);
}

15
src/perl/perl-sources.h Normal file
View File

@ -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

411
src/perl/perl.c
View File

@ -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);
}

21
src/perl/ui/UI.xs
View File

@ -91,25 +91,9 @@ static void perl_unregister_theme(const char *package)
theme_unregister_module(package); theme_unregister_module(package);
} }
static void sig_script_destroy(const char *type, const char *name, static void sig_script_destroy(PERL_SCRIPT_REC *script)
const char *package)
{ {
if (strcmp(type, "PERL") == 0) perl_unregister_theme(script->package);
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);
}
} }
static PLAIN_OBJECT_INIT_REC fe_plains[] = { static PLAIN_OBJECT_INIT_REC fe_plains[] = {
@ -135,7 +119,6 @@ CODE:
irssi_add_plains(fe_plains); irssi_add_plains(fe_plains);
signal_add("script destroy", (SIGNAL_FUNC) sig_script_destroy); signal_add("script destroy", (SIGNAL_FUNC) sig_script_destroy);
signal_add("perl stop", (SIGNAL_FUNC) sig_perl_stop);
INCLUDE: Themes.xs INCLUDE: Themes.xs