diff options
Diffstat (limited to 'src/perl')
69 files changed, 9237 insertions, 0 deletions
diff --git a/src/perl/Makefile.am b/src/perl/Makefile.am new file mode 100644 index 0000000..ca81d3c --- /dev/null +++ b/src/perl/Makefile.am @@ -0,0 +1,170 @@ +moduledir = $(libdir)/irssi/modules + +perl_dirs = common irc ui textui + +module_LTLIBRARIES = $(perl_module_lib) $(perl_module_fe_lib) +noinst_LTLIBRARIES = $(perl_static_lib) $(perl_static_fe_lib) +EXTRA_LTLIBRARIES = \ + libperl_core.la libfe_perl.la \ + libperl_core_static.la libfe_perl_static.la + +libperl_core_la_LDFLAGS = -module -avoid-version -rpath $(moduledir) +libfe_perl_la_LDFLAGS = -module -avoid-version -rpath $(moduledir) + +perl-core.lo: irssi-core.pl.h +perl-signals.lo: perl-signals-list.h + +AM_CPPFLAGS = \ + -I$(top_builddir) \ + -I$(builddir) \ + $(GLIB_CFLAGS) \ + -DSCRIPTDIR=\""$(datadir)/irssi/scripts"\" \ + -DPERL_USE_LIB=\""$(PERL_USE_LIB)"\" \ + -DPERL_STATIC_LIBS=$(PERL_STATIC_LIBS) \ + $(PERL_CFLAGS) + +perl_sources = \ + perl-core.c \ + perl-common.c \ + perl-signals.c \ + perl-sources.c + +perl_fe_sources = \ + module-formats.c \ + perl-fe.c + +noinst_HEADERS = \ + module.h \ + module-fe.h \ + module-formats.h \ + perl-core.h \ + perl-common.h \ + perl-signals.h \ + perl-sources.h + +libperl_core_la_SOURCES = \ + $(perl_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)/utils/file2header.sh $(srcdir)/irssi-core.pl irssi_core_code > irssi-core.pl.h + +common_sources = \ + common/Irssi.xs \ + common/Irssi.pm \ + common/Channel.xs \ + common/Core.xs \ + common/Expando.xs \ + common/Ignore.xs \ + common/Log.xs \ + common/Masks.xs \ + common/Query.xs \ + common/Rawlog.xs \ + common/Server.xs \ + common/Settings.xs \ + common/Makefile.PL.in \ + common/typemap \ + common/module.h + +irc_sources = \ + irc/Irc.xs \ + irc/Irc.pm \ + irc/Dcc.xs \ + irc/Channel.xs \ + irc/Ctcp.xs \ + irc/Query.xs \ + irc/Server.xs \ + irc/Modes.xs \ + irc/Netsplit.xs \ + irc/Notifylist.xs \ + irc/Client.xs \ + irc/Makefile.PL.in \ + irc/typemap \ + irc/module.h + +ui_sources = \ + ui/UI.xs \ + ui/UI.pm \ + ui/Formats.xs \ + ui/Themes.xs \ + ui/Window.xs \ + ui/Makefile.PL.in \ + ui/typemap \ + ui/module.h + +textui_sources = \ + textui/TextUI.xs \ + textui/TextUI.pm \ + textui/TextBuffer.xs \ + textui/TextBufferView.xs \ + textui/Statusbar.xs \ + textui/Makefile.PL.in \ + textui/wrapper_buffer_line.h \ + textui/typemap \ + textui/module.h + +EXTRA_DIST = \ + get-signals.pl \ + irssi-core.pl \ + Makefile_silent.pm \ + $(common_sources) \ + $(irc_sources) \ + $(ui_sources) \ + $(textui_sources) \ + meson.build \ + common/meson.build \ + irc/meson.build \ + ui/meson.build \ + textui/meson.build + +am_v_pl__show_gen = $(am__v_pl__show_gen_$(V)) +am_v_pl__hide_gen = $(am__v_pl__hide_gen_$(V)) +am__v_pl__show_gen_ = $(am__v_pl__show_gen_$(AM_DEFAULT_VERBOSITY)) +am__v_pl__hide_gen_ = $(am__v_pl__hide_gen_$(AM_DEFAULT_VERBOSITY)) +am__v_pl__show_gen_0 = echo " GEN " $$dir ; +am__v_pl__hide_gen_0 = > /dev/null +am__v_pl__show_gen_1 = +am__v_pl__hide_gen_1 = + +all-local: + $(AM_V_GEN)for dir in $(perl_dirs); do \ + cd $$dir && \ + if [ ! -f Makefile ]; then \ + $(am_v_pl__show_gen)$(perlpath) Makefile.PL $(PERL_MM_PARAMS) $(am_v_pl__hide_gen); \ + fi && \ + ($(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS) || \ + $(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS)) && \ + cd ..; \ + done + +install-exec-local: + for dir in $(perl_dirs); do \ + cd $$dir && $(MAKE) install && cd ..; \ + done + +clean-generic: + for dir in $(perl_dirs); do \ + cd $$dir; \ + $(MAKE) clean; \ + cd ..; \ + done + +distclean-generic: + for dir in $(perl_dirs); do \ + cd $$dir; \ + $(MAKE) realclean; rm -f Makefile.PL Makefile; \ + cd ..; \ + done + +libperl_core_la_LIBADD = $(PERL_LDFLAGS) diff --git a/src/perl/Makefile.in b/src/perl/Makefile.in new file mode 100644 index 0000000..25f4d1a --- /dev/null +++ b/src/perl/Makefile.in @@ -0,0 +1,928 @@ +# Makefile.in generated by automake 1.16.5 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2021 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = src/perl +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/glib-2.0.m4 \ + $(top_srcdir)/m4/glibtests.m4 $(top_srcdir)/m4/libgcrypt.m4 \ + $(top_srcdir)/m4/libotr.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/pkg.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(noinst_HEADERS) \ + $(am__DIST_COMMON) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/irssi-config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(moduledir)" +LTLIBRARIES = $(module_LTLIBRARIES) $(noinst_LTLIBRARIES) +libfe_perl_la_LIBADD = +am__objects_1 = module-formats.lo perl-fe.lo +am_libfe_perl_la_OBJECTS = $(am__objects_1) +libfe_perl_la_OBJECTS = $(am_libfe_perl_la_OBJECTS) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +libfe_perl_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(libfe_perl_la_LDFLAGS) $(LDFLAGS) -o $@ +libfe_perl_static_la_LIBADD = +am_libfe_perl_static_la_OBJECTS = $(am__objects_1) +libfe_perl_static_la_OBJECTS = $(am_libfe_perl_static_la_OBJECTS) +am__DEPENDENCIES_1 = +libperl_core_la_DEPENDENCIES = $(am__DEPENDENCIES_1) +am__objects_2 = perl-core.lo perl-common.lo perl-signals.lo \ + perl-sources.lo +am_libperl_core_la_OBJECTS = $(am__objects_2) +libperl_core_la_OBJECTS = $(am_libperl_core_la_OBJECTS) +libperl_core_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC \ + $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(CCLD) \ + $(AM_CFLAGS) $(CFLAGS) $(libperl_core_la_LDFLAGS) $(LDFLAGS) \ + -o $@ +libperl_core_static_la_LIBADD = +am_libperl_core_static_la_OBJECTS = $(am__objects_2) +libperl_core_static_la_OBJECTS = $(am_libperl_core_static_la_OBJECTS) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = +depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp +am__maybe_remake_depfiles = depfiles +am__depfiles_remade = ./$(DEPDIR)/module-formats.Plo \ + ./$(DEPDIR)/perl-common.Plo ./$(DEPDIR)/perl-core.Plo \ + ./$(DEPDIR)/perl-fe.Plo ./$(DEPDIR)/perl-signals.Plo \ + ./$(DEPDIR)/perl-sources.Plo +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libfe_perl_la_SOURCES) $(libfe_perl_static_la_SOURCES) \ + $(libperl_core_la_SOURCES) $(libperl_core_static_la_SOURCES) +DIST_SOURCES = $(libfe_perl_la_SOURCES) \ + $(libfe_perl_static_la_SOURCES) $(libperl_core_la_SOURCES) \ + $(libperl_core_static_la_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +HEADERS = $(noinst_HEADERS) +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +am__DIST_COMMON = $(srcdir)/Makefile.in \ + $(top_srcdir)/build-aux/depcomp +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CHAT_MODULES = @CHAT_MODULES@ +COMMON_LIBS = @COMMON_LIBS@ +COMMON_NOUI_LIBS = @COMMON_NOUI_LIBS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CSCOPE = @CSCOPE@ +CTAGS = @CTAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +ETAGS = @ETAGS@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +FILECMD = @FILECMD@ +FUZZER_LIBS = @FUZZER_LIBS@ +GLIB_CFLAGS = @GLIB_CFLAGS@ +GLIB_GENMARSHAL = @GLIB_GENMARSHAL@ +GLIB_LIBS = @GLIB_LIBS@ +GLIB_MKENUMS = @GLIB_MKENUMS@ +GOBJECT_QUERY = @GOBJECT_QUERY@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBGCRYPT_CFLAGS = @LIBGCRYPT_CFLAGS@ +LIBGCRYPT_CONFIG = @LIBGCRYPT_CONFIG@ +LIBGCRYPT_LIBS = @LIBGCRYPT_LIBS@ +LIBOBJS = @LIBOBJS@ +LIBOTR_CFLAGS = @LIBOTR_CFLAGS@ +LIBOTR_LIBS = @LIBOTR_LIBS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OPENSSL_CFLAGS = @OPENSSL_CFLAGS@ +OPENSSL_LIBS = @OPENSSL_LIBS@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +OTR_CFLAGS = @OTR_CFLAGS@ +OTR_LDFLAGS = @OTR_LDFLAGS@ +OTR_LINK_FLAGS = @OTR_LINK_FLAGS@ +OTR_LINK_LIBS = @OTR_LINK_LIBS@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PERL_CFLAGS = @PERL_CFLAGS@ +PERL_EXTRA_OPTS = @PERL_EXTRA_OPTS@ +PERL_FE_LINK_LIBS = @PERL_FE_LINK_LIBS@ +PERL_LDFLAGS = @PERL_LDFLAGS@ +PERL_LINK_FLAGS = @PERL_LINK_FLAGS@ +PERL_LINK_LIBS = @PERL_LINK_LIBS@ +PERL_MM_OPT = @PERL_MM_OPT@ +PERL_MM_PARAMS = @PERL_MM_PARAMS@ +PERL_STATIC_LIBS = @PERL_STATIC_LIBS@ +PERL_USE_LIB = @PERL_USE_LIB@ +PKG_CONFIG = @PKG_CONFIG@ +PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ +PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ +PROG_LIBS = @PROG_LIBS@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +TEXTUI_LIBS = @TEXTUI_LIBS@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +installed_test_metadir = @installed_test_metadir@ +installed_testdir = @installed_testdir@ +irc_MODULES = @irc_MODULES@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +otr_module_lib = @otr_module_lib@ +otr_static_lib = @otr_static_lib@ +pdfdir = @pdfdir@ +perl_module_fe_lib = @perl_module_fe_lib@ +perl_module_lib = @perl_module_lib@ +perl_static_fe_lib = @perl_static_fe_lib@ +perl_static_lib = @perl_static_lib@ +perlpath = @perlpath@ +pkgconfigdir = @pkgconfigdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +runstatedir = @runstatedir@ +sbindir = @sbindir@ +sedpath = @sedpath@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +moduledir = $(libdir)/irssi/modules +perl_dirs = common irc ui textui +module_LTLIBRARIES = $(perl_module_lib) $(perl_module_fe_lib) +noinst_LTLIBRARIES = $(perl_static_lib) $(perl_static_fe_lib) +EXTRA_LTLIBRARIES = \ + libperl_core.la libfe_perl.la \ + libperl_core_static.la libfe_perl_static.la + +libperl_core_la_LDFLAGS = -module -avoid-version -rpath $(moduledir) +libfe_perl_la_LDFLAGS = -module -avoid-version -rpath $(moduledir) +AM_CPPFLAGS = \ + -I$(top_builddir) \ + -I$(builddir) \ + $(GLIB_CFLAGS) \ + -DSCRIPTDIR=\""$(datadir)/irssi/scripts"\" \ + -DPERL_USE_LIB=\""$(PERL_USE_LIB)"\" \ + -DPERL_STATIC_LIBS=$(PERL_STATIC_LIBS) \ + $(PERL_CFLAGS) + +perl_sources = \ + perl-core.c \ + perl-common.c \ + perl-signals.c \ + perl-sources.c + +perl_fe_sources = \ + module-formats.c \ + perl-fe.c + +noinst_HEADERS = \ + module.h \ + module-fe.h \ + module-formats.h \ + perl-core.h \ + perl-common.h \ + perl-signals.h \ + perl-sources.h + +libperl_core_la_SOURCES = \ + $(perl_sources) + +libperl_core_static_la_SOURCES = \ + $(perl_sources) + +libfe_perl_la_SOURCES = \ + $(perl_fe_sources) + +libfe_perl_static_la_SOURCES = \ + $(perl_fe_sources) + +common_sources = \ + common/Irssi.xs \ + common/Irssi.pm \ + common/Channel.xs \ + common/Core.xs \ + common/Expando.xs \ + common/Ignore.xs \ + common/Log.xs \ + common/Masks.xs \ + common/Query.xs \ + common/Rawlog.xs \ + common/Server.xs \ + common/Settings.xs \ + common/Makefile.PL.in \ + common/typemap \ + common/module.h + +irc_sources = \ + irc/Irc.xs \ + irc/Irc.pm \ + irc/Dcc.xs \ + irc/Channel.xs \ + irc/Ctcp.xs \ + irc/Query.xs \ + irc/Server.xs \ + irc/Modes.xs \ + irc/Netsplit.xs \ + irc/Notifylist.xs \ + irc/Client.xs \ + irc/Makefile.PL.in \ + irc/typemap \ + irc/module.h + +ui_sources = \ + ui/UI.xs \ + ui/UI.pm \ + ui/Formats.xs \ + ui/Themes.xs \ + ui/Window.xs \ + ui/Makefile.PL.in \ + ui/typemap \ + ui/module.h + +textui_sources = \ + textui/TextUI.xs \ + textui/TextUI.pm \ + textui/TextBuffer.xs \ + textui/TextBufferView.xs \ + textui/Statusbar.xs \ + textui/Makefile.PL.in \ + textui/wrapper_buffer_line.h \ + textui/typemap \ + textui/module.h + +EXTRA_DIST = \ + get-signals.pl \ + irssi-core.pl \ + Makefile_silent.pm \ + $(common_sources) \ + $(irc_sources) \ + $(ui_sources) \ + $(textui_sources) \ + meson.build \ + common/meson.build \ + irc/meson.build \ + ui/meson.build \ + textui/meson.build + +am_v_pl__show_gen = $(am__v_pl__show_gen_$(V)) +am_v_pl__hide_gen = $(am__v_pl__hide_gen_$(V)) +am__v_pl__show_gen_ = $(am__v_pl__show_gen_$(AM_DEFAULT_VERBOSITY)) +am__v_pl__hide_gen_ = $(am__v_pl__hide_gen_$(AM_DEFAULT_VERBOSITY)) +am__v_pl__show_gen_0 = echo " GEN " $$dir ; +am__v_pl__hide_gen_0 = > /dev/null +am__v_pl__show_gen_1 = +am__v_pl__hide_gen_1 = +libperl_core_la_LIBADD = $(PERL_LDFLAGS) +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign src/perl/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign src/perl/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +install-moduleLTLIBRARIES: $(module_LTLIBRARIES) + @$(NORMAL_INSTALL) + @list='$(module_LTLIBRARIES)'; test -n "$(moduledir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(MKDIR_P) '$(DESTDIR)$(moduledir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(moduledir)" || exit 1; \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(moduledir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(moduledir)"; \ + } + +uninstall-moduleLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(module_LTLIBRARIES)'; test -n "$(moduledir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(moduledir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(moduledir)/$$f"; \ + done + +clean-moduleLTLIBRARIES: + -test -z "$(module_LTLIBRARIES)" || rm -f $(module_LTLIBRARIES) + @list='$(module_LTLIBRARIES)'; \ + locs=`for p in $$list; do echo $$p; done | \ + sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ + sort -u`; \ + test -z "$$locs" || { \ + echo rm -f $${locs}; \ + rm -f $${locs}; \ + } + +clean-noinstLTLIBRARIES: + -test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES) + @list='$(noinst_LTLIBRARIES)'; \ + locs=`for p in $$list; do echo $$p; done | \ + sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ + sort -u`; \ + test -z "$$locs" || { \ + echo rm -f $${locs}; \ + rm -f $${locs}; \ + } + +libfe_perl.la: $(libfe_perl_la_OBJECTS) $(libfe_perl_la_DEPENDENCIES) $(EXTRA_libfe_perl_la_DEPENDENCIES) + $(AM_V_CCLD)$(libfe_perl_la_LINK) $(libfe_perl_la_OBJECTS) $(libfe_perl_la_LIBADD) $(LIBS) + +libfe_perl_static.la: $(libfe_perl_static_la_OBJECTS) $(libfe_perl_static_la_DEPENDENCIES) $(EXTRA_libfe_perl_static_la_DEPENDENCIES) + $(AM_V_CCLD)$(LINK) $(libfe_perl_static_la_OBJECTS) $(libfe_perl_static_la_LIBADD) $(LIBS) + +libperl_core.la: $(libperl_core_la_OBJECTS) $(libperl_core_la_DEPENDENCIES) $(EXTRA_libperl_core_la_DEPENDENCIES) + $(AM_V_CCLD)$(libperl_core_la_LINK) $(libperl_core_la_OBJECTS) $(libperl_core_la_LIBADD) $(LIBS) + +libperl_core_static.la: $(libperl_core_static_la_OBJECTS) $(libperl_core_static_la_DEPENDENCIES) $(EXTRA_libperl_core_static_la_DEPENDENCIES) + $(AM_V_CCLD)$(LINK) $(libperl_core_static_la_OBJECTS) $(libperl_core_static_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/module-formats.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perl-common.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perl-core.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perl-fe.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perl-signals.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perl-sources.Plo@am__quote@ # am--include-marker + +$(am__depfiles_remade): + @$(MKDIR_P) $(@D) + @echo '# dummy' >$@-t && $(am__mv) $@-t $@ + +am--depfiles: $(am__depfiles_remade) + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\ +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCC_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.obj$$||'`;\ +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ `$(CYGPATH_W) '$<'` &&\ +@am__fastdepCC_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(AM_V_CC)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.lo$$||'`;\ +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCC_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +distdir: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) distdir-am + +distdir-am: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) $(HEADERS) all-local +installdirs: + for dir in "$(DESTDIR)$(moduledir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-moduleLTLIBRARIES \ + clean-noinstLTLIBRARIES mostlyclean-am + +distclean: distclean-am + -rm -f ./$(DEPDIR)/module-formats.Plo + -rm -f ./$(DEPDIR)/perl-common.Plo + -rm -f ./$(DEPDIR)/perl-core.Plo + -rm -f ./$(DEPDIR)/perl-fe.Plo + -rm -f ./$(DEPDIR)/perl-signals.Plo + -rm -f ./$(DEPDIR)/perl-sources.Plo + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: install-moduleLTLIBRARIES + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-exec-local + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f ./$(DEPDIR)/module-formats.Plo + -rm -f ./$(DEPDIR)/perl-common.Plo + -rm -f ./$(DEPDIR)/perl-core.Plo + -rm -f ./$(DEPDIR)/perl-fe.Plo + -rm -f ./$(DEPDIR)/perl-signals.Plo + -rm -f ./$(DEPDIR)/perl-sources.Plo + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-moduleLTLIBRARIES + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am all-local am--depfiles check \ + check-am clean clean-generic clean-libtool \ + clean-moduleLTLIBRARIES clean-noinstLTLIBRARIES cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-libtool distclean-tags distdir dvi dvi-am html \ + html-am info info-am install install-am install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-exec-local install-html \ + install-html-am install-info install-info-am install-man \ + install-moduleLTLIBRARIES install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am \ + uninstall-moduleLTLIBRARIES + +.PRECIOUS: Makefile + + +perl-core.lo: irssi-core.pl.h +perl-signals.lo: perl-signals-list.h + +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)/utils/file2header.sh $(srcdir)/irssi-core.pl irssi_core_code > irssi-core.pl.h + +all-local: + $(AM_V_GEN)for dir in $(perl_dirs); do \ + cd $$dir && \ + if [ ! -f Makefile ]; then \ + $(am_v_pl__show_gen)$(perlpath) Makefile.PL $(PERL_MM_PARAMS) $(am_v_pl__hide_gen); \ + fi && \ + ($(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS) || \ + $(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS)) && \ + cd ..; \ + done + +install-exec-local: + for dir in $(perl_dirs); do \ + cd $$dir && $(MAKE) install && cd ..; \ + done + +clean-generic: + for dir in $(perl_dirs); do \ + cd $$dir; \ + $(MAKE) clean; \ + cd ..; \ + done + +distclean-generic: + for dir in $(perl_dirs); do \ + cd $$dir; \ + $(MAKE) realclean; rm -f Makefile.PL Makefile; \ + cd ..; \ + done + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/src/perl/Makefile_silent.pm b/src/perl/Makefile_silent.pm new file mode 100644 index 0000000..b5d71d6 --- /dev/null +++ b/src/perl/Makefile_silent.pm @@ -0,0 +1,76 @@ +push @ExtUtils::MakeMaker::Overridable, qw(pm_to_blib); +my $verb = $AM_DEFAULT_VERBOSITY; +{ package MY; + sub _center { + my $z = shift; + (length $z == 2 ? " $z " : length $z == 4 ? " $z " : " $z ").' ' + } + sub _silent_cmd { + my $z = shift; + $z =~ s{\t(?:- ?)?\K(?=\$\((?|(CC)CMD|(XS)UBPPRUN|(LD|MV|CHMOD)|(RM)_R?F|(CP)_NONEMPTY|FULL_(AR)\)))}{\$(PL_AM_V_$1)}g; + $z + } + sub c_o { _silent_cmd(shift->SUPER::c_o(@_)) } + sub xs_c { _silent_cmd(shift->SUPER::xs_c(@_)) } + sub xs_o { _silent_cmd(shift->SUPER::xs_o(@_)) } + sub dynamic_lib { _silent_cmd(shift->SUPER::dynamic_lib(@_)) } + sub static_lib { _silent_cmd(shift->SUPER::static_lib(@_)) } + sub dynamic_bs { + my $ret = shift->SUPER::dynamic_bs(@_); + $ret =~ s{Running Mkbootstrap for}{\$(PL_AM_V_BS_Text)}g; + _silent_cmd($ret) + } + sub pm_to_blib { + my $ret = shift->SUPER::pm_to_blib(@_); + $ret =~ s{^(\t(?:- ?)?)(?:\$\(NOECHO\) ?)?(.*-e ['"]pm_to_blib(.*\\\n)*.*)$}{$1\$(PL_AM_V_BLIB)$2\$(PL_AM_V_BLIB_Hide)}mg; + $ret + } + sub post_constants { + my $ret = shift->SUPER::post_constants(@_); + my @terse = qw(cc xs ld chmod cp ar blib); + my @silent = qw(mv rm); + my @special = qw(BLIB_Hide); + + #default verbosity from command line parameter + $ret .= " +AM_DEFAULT_VERBOSITY = @{[$verb ? 1 : 0]} +"; + #default options forward + $ret .= " +PL_AM_V_${_} = \$(pl_am__v_${_}_\$(V)) +pl_am__v_${_}_ = \$(pl_am__v_${_}_\$(AM_DEFAULT_VERBOSITY)) +" for @special, map uc, @terse, @silent; + + #quoted plain text needs extra quotes + $ret .= " +PL_AM_V_BS_Text = \"\$(pl_am__v_BS_Text_\$(V))\" +pl_am__v_BS_Text_ = \$(pl_am__v_BS_Text_\$(AM_DEFAULT_VERBOSITY)) +" + #hide pm_to_blib output +. " +pl_am__v_BLIB_Hide_0 = \$(DEV_NULL) +pl_am__v_BLIB_Hide_1 = +" + #text for Mkbootstrap +. " +pl_am__v_BS_Text_0 = \"@{[_center('BS')]}\" +pl_am__v_BS_Text_1 = \"Running Mkbootstrap for\" +"; + #"terse" output + $ret .= " +pl_am__v_${_}_0 = \$(NOECHO)echo \"@{[_center($_)]}\" \$\@; +" for map uc, @terse; + + #no output + $ret .= " +pl_am__v_${_}_0 = \$(NOECHO) +" for map uc, @silent; + + #in verbose mode the "terse" echo expands to nothing + $ret .= " +pl_am__v_${_}_1 = +" for map uc, @terse, @silent; + $ret + } +} +1; diff --git a/src/perl/common/Channel.xs b/src/perl/common/Channel.xs new file mode 100644 index 0000000..69141c7 --- /dev/null +++ b/src/perl/common/Channel.xs @@ -0,0 +1,117 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Channel PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +channels() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = channels; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(iobject_bless((CHANNEL_REC *) tmp->data))); + } + +Irssi::Channel +channel_find(channel) + char *channel +CODE: + RETVAL = channel_find(NULL, channel); +OUTPUT: + RETVAL + +#******************************* +MODULE = Irssi::Channel PACKAGE = Irssi::Server +#******************************* + +void +channels(server) + Irssi::Server server +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = server->channels; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(iobject_bless((CHANNEL_REC *) tmp->data))); + } + +void +channels_join(server, channels, automatic) + Irssi::Server server + char *channels + int automatic +CODE: + server->channels_join(server, channels, automatic); + +Irssi::Channel +channel_find(server, name) + Irssi::Server server + char *name + +void +nicks_get_same(server, nick) + Irssi::Server server + char *nick +PREINIT: + GSList *list, *tmp; +PPCODE: + list = nicklist_get_same(server, nick); + + for (tmp = list; tmp != NULL; tmp = tmp->next->next) { + XPUSHs(sv_2mortal(iobject_bless((CHANNEL_REC *) tmp->data))); + XPUSHs(sv_2mortal(iobject_bless((NICK_REC *) tmp->next->data))); + } + g_slist_free(list); + +#******************************* +MODULE = Irssi::Channel PACKAGE = Irssi::Channel PREFIX = channel_ +#******************************* + +void +channel_destroy(channel) + Irssi::Channel channel + +void +nick_insert(channel, nick) + Irssi::Channel channel + Irssi::Nick nick +CODE: + nicklist_insert(channel, nick); + +void +nick_remove(channel, nick) + Irssi::Channel channel + Irssi::Nick nick +CODE: + nicklist_remove(channel, nick); + +Irssi::Nick +nick_find(channel, nick) + Irssi::Channel channel + char *nick +CODE: + RETVAL = nicklist_find(channel, nick); +OUTPUT: + RETVAL + +Irssi::Nick +nick_find_mask(channel, mask) + Irssi::Channel channel + char *mask +CODE: + RETVAL = nicklist_find_mask(channel, mask); +OUTPUT: + RETVAL + +void +nicks(channel) + Irssi::Channel channel +PREINIT: + GSList *list, *tmp; +PPCODE: + list = nicklist_getnicks(channel); + + for (tmp = list; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(iobject_bless((NICK_REC *) tmp->data))); + } + g_slist_free(list); diff --git a/src/perl/common/Core.xs b/src/perl/common/Core.xs new file mode 100644 index 0000000..9e582a7 --- /dev/null +++ b/src/perl/common/Core.xs @@ -0,0 +1,750 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/irssi-version.h> +#include <irssi/src/core/core.h> +#include <irssi/src/core/utf8.h> +#include <irssi/src/core/recode.h> + +#include <irssi/src/core/pidwait.h> +#include <irssi/src/core/session.h> + +#define DEFAULT_COMMAND_CATEGORY "Perl scripts' commands" + +static void perl_signal_add_hash(int priority, SV *sv) +{ + HV *hv; + HE *he; + I32 len; + + if (!is_hvref(sv)) + croak("Usage: Irssi::signal_add(hash)"); + + hv = hvref(sv); + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) + perl_signal_add_full(hv_iterkey(he, &len), HeVAL(he), priority); +} + +static void perl_command_bind_add_hash(int priority, SV *sv, char *category) +{ + HV *hv; + HE *he; + I32 len; + + hv = hvref(sv); + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) + perl_command_bind_to(hv_iterkey(he, &len), category, HeVAL(he), priority); +} + +static void handle_command_bind(int priority, int items, SV *p0, SV *p1, SV *p2) +{ + char *category; + int hash; + + hash = items > 0 && is_hvref(p0); + if (!hash) { + if (items < 2 || items > 3) + croak("Usage: Irssi::command_bind(signal, func, category)"); + } else if (items > 2) + croak("Usage: Irssi::command_bind(signals_hash, category)"); + + if (!hash) { + category = items < 3 ? DEFAULT_COMMAND_CATEGORY : + SvPV_nolen(p2); + perl_command_bind_to(SvPV_nolen(p0), category, p1, priority); + } else { + category = items < 2 ? DEFAULT_COMMAND_CATEGORY : + SvPV_nolen(p1); + perl_command_bind_add_hash(priority, p0, category); + } +} + +static void add_tuple(gpointer key_, gpointer value_, gpointer user_data) +{ + HV *hash = user_data; + char *key = key_; + char *value = value_; + (void) hv_store(hash, key, strlen(key), new_pv(value), 0); +} + +static void wrap_signal_emit(void *signal, int params, void **p) +{ + signal_emit(signal, params, p[0], p[1], p[2], p[3], p[4], p[5]); +} + +static void wrap_signal_continue(void *dummy, int params, void **p) +{ + (void)dummy; + signal_continue(params, p[0], p[1], p[2], p[3], p[4], p[5]); +} + +MODULE = Irssi::Core PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +signal_emit(signal, ...) + char *signal +CODE: + int signal_id; + + signal_id = signal_get_uniq_id(signal); + perl_signal_args_to_c(wrap_signal_emit, signal, signal_id, &ST(1), items - 1); + +void +signal_continue(...) +CODE: + perl_signal_args_to_c(wrap_signal_continue, NULL, signal_get_emitted_id(), &ST(0), items); + +void +signal_add(...) +CODE: + if (items != 1 && items != 2) + croak("Usage: Irssi::signal_add(signal, func)"); + if (items == 2) + perl_signal_add_full(SvPV_nolen(ST(0)), ST(1), + SIGNAL_PRIORITY_DEFAULT); + else + perl_signal_add_hash(SIGNAL_PRIORITY_DEFAULT, ST(0)); + +void +signal_add_first(...) +CODE: + if (items != 1 && items != 2) + croak("Usage: Irssi::signal_add_first(signal, func)"); + if (items == 2) + perl_signal_add_full(SvPV_nolen(ST(0)), ST(1), + SIGNAL_PRIORITY_HIGH); + else + perl_signal_add_hash(SIGNAL_PRIORITY_HIGH, ST(0)); + +void +signal_add_last(...) +CODE: + if (items != 1 && items != 2) + croak("Usage: Irssi::signal_add_last(signal, func)"); + if (items == 2) + perl_signal_add_full(SvPV_nolen(ST(0)), ST(1), + SIGNAL_PRIORITY_LOW); + else + perl_signal_add_hash(SIGNAL_PRIORITY_LOW, ST(0)); + +void +signal_add_priority(...) +CODE: + if (items != 2 && items != 3) + croak("Usage: Irssi::signal_add_priority(signal, func, priority)"); + if (items == 3) + perl_signal_add_full(SvPV_nolen(ST(0)), ST(1), SvIV(ST(2))); + else + perl_signal_add_hash(SvIV(ST(0)), ST(1)); + +void +signal_register(...) +PREINIT: + HV *hv; + HE *he; + I32 len, pos; + const char *arr[SIGNAL_MAX_ARGUMENTS + 1]; +CODE: + if (items != 1 || !is_hvref(ST(0))) + croak("Usage: Irssi::signal_register(hash)"); + + hv = hvref(ST(0)); + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) { + const char *key = hv_iterkey(he, &len); + SV *val = HeVAL(he); + AV *av; + + if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV) + croak("not array reference"); + + av = (AV *) SvRV(val); + len = av_len(av)+1; + if (len > SIGNAL_MAX_ARGUMENTS) + len = SIGNAL_MAX_ARGUMENTS; + for (pos = 0; pos < len; pos++) { + SV **val = av_fetch(av, pos, 0); + arr[pos] = SvPV_nolen(*val); + } + arr[pos] = NULL; + perl_signal_register(key, arr); + } + + +int +SIGNAL_PRIORITY_LOW() +CODE: + RETVAL = SIGNAL_PRIORITY_LOW; +OUTPUT: + RETVAL + +int +SIGNAL_PRIORITY_DEFAULT() +CODE: + RETVAL = SIGNAL_PRIORITY_DEFAULT; +OUTPUT: + RETVAL + +int +SIGNAL_PRIORITY_HIGH() +CODE: + RETVAL = SIGNAL_PRIORITY_HIGH; +OUTPUT: + RETVAL + +void +signal_remove(signal, func) + char *signal + SV *func +CODE: + perl_signal_remove(signal, func); + +void +signal_stop() + +void +signal_stop_by_name(signal) + char *signal + +char * +signal_get_emitted() +CODE: + RETVAL = (char *) signal_get_emitted(); +OUTPUT: + RETVAL + +int +signal_get_emitted_id() + +int +timeout_add(msecs, func, data) + int msecs + SV *func + SV *data +CODE: + if (msecs < 10) { + croak("Irssi::timeout() : msecs must be >= 10"); + RETVAL = -1; + } else { + RETVAL = perl_timeout_add(msecs, func, data, FALSE); + } +OUTPUT: + RETVAL + +int +timeout_add_once(msecs, func, data) + int msecs + SV *func + SV *data +CODE: + if (msecs < 10) { + croak("Irssi::timeout_once() : msecs must be >= 10"); + RETVAL = -1; + } else { + RETVAL = perl_timeout_add(msecs, func, data, TRUE); + } +OUTPUT: + RETVAL + +void +timeout_remove(tag) + int tag +CODE: + perl_source_remove(tag); + + +int +INPUT_READ() +CODE: + RETVAL = I_INPUT_READ; +OUTPUT: + RETVAL + +int +INPUT_WRITE() +CODE: + RETVAL = I_INPUT_WRITE; +OUTPUT: + RETVAL + +int +input_add(source, condition, func, data) + int source + int condition + SV *func + SV *data +CODE: + RETVAL = perl_input_add(source, condition, func, data, FALSE); +OUTPUT: + RETVAL + +void +input_remove(tag) + int tag +CODE: + perl_source_remove(tag); + +# maybe there's some easier way than this..? :) +int +MSGLEVEL_HIDDEN() +CODE: + RETVAL = MSGLEVEL_HIDDEN; +OUTPUT: + RETVAL + +int +MSGLEVEL_CRAP() +CODE: + RETVAL = MSGLEVEL_CRAP; +OUTPUT: + RETVAL + +int +MSGLEVEL_MSGS() +CODE: + RETVAL = MSGLEVEL_MSGS; +OUTPUT: + RETVAL + +int +MSGLEVEL_PUBLIC() +CODE: + RETVAL = MSGLEVEL_PUBLIC; +OUTPUT: + RETVAL + +int +MSGLEVEL_NOTICES() +CODE: + RETVAL = MSGLEVEL_NOTICES; +OUTPUT: + RETVAL + +int +MSGLEVEL_SNOTES() +CODE: + RETVAL = MSGLEVEL_SNOTES; +OUTPUT: + RETVAL + +int +MSGLEVEL_CTCPS() +CODE: + RETVAL = MSGLEVEL_CTCPS; +OUTPUT: + RETVAL + +int +MSGLEVEL_ACTIONS() +CODE: + RETVAL = MSGLEVEL_ACTIONS; +OUTPUT: + RETVAL + +int +MSGLEVEL_JOINS() +CODE: + RETVAL = MSGLEVEL_JOINS; +OUTPUT: + RETVAL + +int +MSGLEVEL_PARTS() +CODE: + RETVAL = MSGLEVEL_PARTS; +OUTPUT: + RETVAL + +int +MSGLEVEL_QUITS() +CODE: + RETVAL = MSGLEVEL_QUITS; +OUTPUT: + RETVAL + +int +MSGLEVEL_KICKS() +CODE: + RETVAL = MSGLEVEL_KICKS; +OUTPUT: + RETVAL + +int +MSGLEVEL_MODES() +CODE: + RETVAL = MSGLEVEL_MODES; +OUTPUT: + RETVAL + +int +MSGLEVEL_TOPICS() +CODE: + RETVAL = MSGLEVEL_TOPICS; +OUTPUT: + RETVAL + +int +MSGLEVEL_WALLOPS() +CODE: + RETVAL = MSGLEVEL_WALLOPS; +OUTPUT: + RETVAL + +int +MSGLEVEL_INVITES() +CODE: + RETVAL = MSGLEVEL_INVITES; +OUTPUT: + RETVAL + +int +MSGLEVEL_NICKS() +CODE: + RETVAL = MSGLEVEL_NICKS; +OUTPUT: + RETVAL + +int +MSGLEVEL_DCC() +CODE: + RETVAL = MSGLEVEL_DCC; +OUTPUT: + RETVAL + +int +MSGLEVEL_DCCMSGS() +CODE: + RETVAL = MSGLEVEL_DCCMSGS; +OUTPUT: + RETVAL + +int +MSGLEVEL_CLIENTNOTICE() +CODE: + RETVAL = MSGLEVEL_CLIENTNOTICE; +OUTPUT: + RETVAL + +int +MSGLEVEL_CLIENTCRAP() +CODE: + RETVAL = MSGLEVEL_CLIENTCRAP; +OUTPUT: + RETVAL + +int +MSGLEVEL_CLIENTERROR() +CODE: + RETVAL = MSGLEVEL_CLIENTERROR; +OUTPUT: + RETVAL + +int +MSGLEVEL_HILIGHT() +CODE: + RETVAL = MSGLEVEL_HILIGHT; +OUTPUT: + RETVAL + +int +MSGLEVEL_ALL() +CODE: + RETVAL = MSGLEVEL_ALL; +OUTPUT: + RETVAL + +int +MSGLEVEL_NOHILIGHT() +CODE: + RETVAL = MSGLEVEL_NOHILIGHT; +OUTPUT: + RETVAL + +int +MSGLEVEL_NO_ACT() +CODE: + RETVAL = MSGLEVEL_NO_ACT; +OUTPUT: + RETVAL + +int +MSGLEVEL_NEVER() +CODE: + RETVAL = MSGLEVEL_NEVER; +OUTPUT: + RETVAL + +int +MSGLEVEL_LASTLOG() +CODE: + RETVAL = MSGLEVEL_LASTLOG; +OUTPUT: + RETVAL + +int +level2bits(str) + char *str +CODE: + RETVAL = level2bits(str, NULL); +OUTPUT: + RETVAL + +void +bits2level(bits) + int bits +PREINIT: + char *ret; +PPCODE: + ret = bits2level(bits); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +int +combine_level(level, str) + int level + char *str + +void +command(cmd) + char *cmd +CODE: + perl_command(cmd, NULL, NULL); + +void +commands() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = commands; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Command"))); + } + +void +command_bind_first(...) +CODE: + handle_command_bind(SIGNAL_PRIORITY_HIGH, items, ST(0), ST(1), ST(2)); + +void +command_bind(...) +CODE: + handle_command_bind(SIGNAL_PRIORITY_DEFAULT, items, ST(0), ST(1), ST(2)); + +void +command_bind_last(...) +CODE: + handle_command_bind(SIGNAL_PRIORITY_LOW, items, ST(0), ST(1), ST(2)); + +void +command_runsub(cmd, data, server, item) + char *cmd + char *data + Irssi::Server server + Irssi::Windowitem item +CODE: + perl_command_runsub(cmd, data, server, item); + +void +command_unbind(cmd, func) + char *cmd + SV *func +CODE: + perl_command_unbind(cmd, func); + +void +command_set_options(cmd, options) + char *cmd + char *options + +void +command_parse_options(cmd, data) + char *cmd + char *data +PREINIT: + HV *hash; + GHashTable *optlist; + void *free_arg; + char *ptr; +PPCODE: + if (cmd_get_params(data, &free_arg, 1 | PARAM_FLAG_OPTIONS | PARAM_FLAG_GETREST, + cmd, &optlist, &ptr)) { + hash = newHV(); + g_hash_table_foreach(optlist, add_tuple, hash); + XPUSHs(sv_2mortal(newRV_noinc((SV*)hash))); + XPUSHs(sv_2mortal(new_pv(ptr))); + cmd_params_free(free_arg); + } else { + XPUSHs(&PL_sv_undef); + XPUSHs(&PL_sv_undef); + } + +void +pidwait_add(pid) + int pid + +void +pidwait_remove(pid) + int pid + +void +parse_special(cmd, data="", flags=0) + char *cmd + char *data + int flags +PREINIT: + char *ret; +PPCODE: + ret = parse_special_string(cmd, NULL, NULL, data, NULL, flags); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free_not_null(ret); + +char * +get_irssi_dir() +CODE: + RETVAL = (char *) get_irssi_dir(); +OUTPUT: + RETVAL + +char * +get_irssi_config() +CODE: + RETVAL = (char *) get_irssi_config(); +OUTPUT: + RETVAL + +char * +get_irssi_binary() +CODE: + RETVAL = irssi_binary; +OUTPUT: + RETVAL + +char * +version() +PREINIT: + char version[100]; +CODE: + g_snprintf(version, sizeof(version), "%d.%04d", + IRSSI_VERSION_DATE, IRSSI_VERSION_TIME); + RETVAL = version; +OUTPUT: + RETVAL + +int +get_gui() +CODE: + RETVAL = irssi_gui; +OUTPUT: + RETVAL + +int +IRSSI_GUI_NONE() +CODE: + RETVAL = IRSSI_GUI_NONE; +OUTPUT: + RETVAL + +int +IRSSI_GUI_TEXT() +CODE: + RETVAL = IRSSI_GUI_TEXT; +OUTPUT: + RETVAL + +int +IRSSI_GUI_GTK() +CODE: + RETVAL = IRSSI_GUI_GTK; +OUTPUT: + RETVAL + +int +IRSSI_GUI_GNOME() +CODE: + RETVAL = IRSSI_GUI_GNOME; +OUTPUT: + RETVAL + +int +IRSSI_GUI_QT() +CODE: + RETVAL = IRSSI_GUI_QT; +OUTPUT: + RETVAL + +int +IRSSI_GUI_KDE() +CODE: + RETVAL = IRSSI_GUI_KDE; +OUTPUT: + RETVAL + +int +string_width(str) + char *str +C_ARGS: + str, is_utf8() ? TREAT_STRING_AS_UTF8 : TREAT_STRING_AS_BYTES + +void +string_chars_for_width(str, width) + char *str + unsigned int width +PREINIT: + int retval; + unsigned int bytes; +PPCODE: + retval = string_chars_for_width(str, is_utf8() ? TREAT_STRING_AS_UTF8 : TREAT_STRING_AS_BYTES, width, &bytes); + mXPUSHi(retval); + mXPUSHu(bytes); + + +#******************************* +MODULE = Irssi::Core PACKAGE = Irssi::Server +#******************************* + +void +parse_special(server, cmd, data="", flags=0) + Irssi::Server server + char *cmd + char *data + int flags +PREINIT: + char *ret; +PPCODE: + ret = parse_special_string(cmd, server, NULL, data, NULL, flags); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free_not_null(ret); + +void +command(server, cmd) + Irssi::Server server + char *cmd +CODE: + perl_command(cmd, server, NULL); + + +#******************************* +MODULE = Irssi::Core PACKAGE = Irssi::Windowitem +#******************************* + +void +parse_special(item, cmd, data="", flags=0) + Irssi::Windowitem item + char *cmd + char *data + int flags +PREINIT: + char *ret; +PPCODE: + ret = parse_special_string(cmd, item->server, item, data, NULL, flags); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free_not_null(ret); + +void +command(item, cmd) + Irssi::Windowitem item + char *cmd +CODE: + perl_command(cmd, item->server, item); + diff --git a/src/perl/common/Expando.xs b/src/perl/common/Expando.xs new file mode 100644 index 0000000..1dc36d2 --- /dev/null +++ b/src/perl/common/Expando.xs @@ -0,0 +1,181 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/expandos.h> + +typedef struct { + PERL_SCRIPT_REC *script; + SV *func; +} PerlExpando; + +static GHashTable *perl_expando_defs; + +static char *sig_perl_expando(SERVER_REC *server, void *item, int *free_ret); + +static int check_expando_destroy(char *key, PerlExpando *rec, + PERL_SCRIPT_REC *script) +{ + if (rec->script == script) { + expando_destroy(key, sig_perl_expando); + SvREFCNT_dec(rec->func); + g_free(key); + g_free(rec); + return TRUE; + } + + return FALSE; +} + +static void script_unregister_expandos(PERL_SCRIPT_REC *script) +{ + g_hash_table_foreach_remove(perl_expando_defs, + (GHRFunc) check_expando_destroy, script); +} + +void perl_expando_init(void) +{ + perl_expando_defs = g_hash_table_new((GHashFunc) g_str_hash, + (GCompareFunc) g_str_equal); + signal_add("script destroyed", (SIGNAL_FUNC) script_unregister_expandos); +} + +static void expando_def_destroy(char *key, PerlExpando *rec) +{ + SvREFCNT_dec(rec->func); + g_free(key); + g_free(rec); +} + +void perl_expando_deinit(void) +{ + signal_remove("script destroyed", (SIGNAL_FUNC) script_unregister_expandos); + + g_hash_table_foreach(perl_expando_defs, + (GHFunc) expando_def_destroy, NULL); + g_hash_table_destroy(perl_expando_defs); +} + +static char *perl_expando_event(PerlExpando *rec, SERVER_REC *server, + WI_ITEM_REC *item, int *free_ret) +{ + dSP; + char *ret; + int retcount; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv_2mortal(iobject_bless(server))); + XPUSHs(sv_2mortal(iobject_bless(item))); + PUTBACK; + + retcount = perl_call_sv(rec->func, G_EVAL|G_SCALAR); + SPAGAIN; + + ret = NULL; + if (SvTRUE(ERRSV)) { + char *error; + PERL_SCRIPT_REC *script = rec->script; + + (void) POPs; + /* call putback before emitting script error signal as that + * could manipulate the perl stack. */ + PUTBACK; + /* make sure we don't get back here */ + if (script != NULL) + script_unregister_expandos(script); + /* rec has been freed now */ + + error = g_strdup(SvPV_nolen(ERRSV)); + signal_emit("script error", 2, script, error); + g_free(error); + } else if (retcount > 0) { + ret = g_strdup(POPp); + *free_ret = TRUE; + PUTBACK; + } + + FREETMPS; + LEAVE; + + return ret; +} + +static char *sig_perl_expando(SERVER_REC *server, void *item, int *free_ret) +{ + PerlExpando *rec; + + rec = g_hash_table_lookup(perl_expando_defs, current_expando); + if (rec != NULL) + return perl_expando_event(rec, server, item, free_ret); + return NULL; +} + +static void expando_signals_add_hash(const char *key, SV *signals) +{ + HV *hv; + HE *he; + I32 len; + const char *argstr; + ExpandoArg arg; + + if (!is_hvref(signals)) { + croak("Usage: Irssi::expando_create(key, func, hash)"); + return; + } + + hv = hvref(signals); + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) { + SV *argsv = HeVAL(he); + argstr = SvPV_nolen(argsv); + + if (g_ascii_strcasecmp(argstr, "none") == 0) + arg = EXPANDO_ARG_NONE; + else if (g_ascii_strcasecmp(argstr, "server") == 0) + arg = EXPANDO_ARG_SERVER; + else if (g_ascii_strcasecmp(argstr, "window") == 0) + arg = EXPANDO_ARG_WINDOW; + else if (g_ascii_strcasecmp(argstr, "windowitem") == 0) + arg = EXPANDO_ARG_WINDOW_ITEM; + else if (g_ascii_strcasecmp(argstr, "never") == 0) + arg = EXPANDO_NEVER; + else { + croak("Unknown signal type: %s", argstr); + break; + } + expando_add_signal(key, hv_iterkey(he, &len), arg); + } +} + +MODULE = Irssi::Expando PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +expando_create(key, func, signals) + char *key + SV *func + SV *signals +PREINIT: + PerlExpando *rec; +CODE: + rec = g_new0(PerlExpando, 1); + rec->script = perl_script_find_package(perl_get_package()); + rec->func = perl_func_sv_inc(func, perl_get_package()); + + expando_create(key, sig_perl_expando, NULL); + g_hash_table_insert(perl_expando_defs, g_strdup(key), rec); + expando_signals_add_hash(key, signals); + +void +expando_destroy(name) + char *name +PREINIT: + gpointer key, value; +CODE: + if (g_hash_table_lookup_extended(perl_expando_defs, name, &key, &value)) { + g_hash_table_remove(perl_expando_defs, name); + g_free(key); + SvREFCNT_dec((SV *) value); + } + expando_destroy(name, sig_perl_expando); diff --git a/src/perl/common/Ignore.xs b/src/perl/common/Ignore.xs new file mode 100644 index 0000000..144497d --- /dev/null +++ b/src/perl/common/Ignore.xs @@ -0,0 +1,74 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Ignore PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +ignores() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = ignores; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Ignore"))); + } + +int +ignore_check(nick, host, channel, text, level) + char *nick + char *host + char *channel + char *text + int level +CODE: + RETVAL = ignore_check(NULL, nick, host, channel, text, level); +OUTPUT: + RETVAL + +int +ignore_check_flags(nick, host, channel, text, level, flags) + char *nick + char *host + char *channel + char *text + int level + int flags +CODE: + RETVAL = ignore_check_flags(NULL, nick, host, channel, text, level, flags); +OUTPUT: + RETVAL + +#******************************* +MODULE = Irssi::Ignore PACKAGE = Irssi::Server +#******************************* + +int +ignore_check(server, nick, host, channel, text, level) + Irssi::Server server + char *nick + char *host + char *channel + char *text + int level + +int +ignore_check_flags(server, nick, host, channel, text, level, flags) + Irssi::Server server + char *nick + char *host + char *channel + char *text + int level + int flags + +#******************************* +MODULE = Irssi::Ignore PACKAGE = Irssi::Ignore PREFIX = ignore_ +#******************************* + +void +ignore_add_rec(rec) + Irssi::Ignore rec + +void +ignore_update_rec(rec) + Irssi::Ignore rec diff --git a/src/perl/common/Irssi.pm b/src/perl/common/Irssi.pm new file mode 100644 index 0000000..bca0084 --- /dev/null +++ b/src/perl/common/Irssi.pm @@ -0,0 +1,171 @@ +# +# Perl interface to irssi functions. +# + +package Irssi; + +use strict; +use Carp; +use vars qw($VERSION $in_irssi @ISA @EXPORT @EXPORT_OK); + +# TIEHANDLE methods + +sub TIEHANDLE { + my ($class, $level, $object, $target) = @_; + return bless [ $level, $object, $target ], $class; +} + +sub WRITE { + croak "Cannot syswrite() to an Irssi handle" +} + +sub PRINT { + my ($self, @list) = @_; + if (defined $self->[1]) { + if (defined $self->[2]) { + $self->[1]->print($self->[2], join('', @list), $self->[0]); + } else { + $self->[1]->print(join('', @list), $self->[0]); + } + } else { + Irssi::print(join('', @list), $self->[0]); + } +} + +sub PRINTF { + my ($self, $format, @list) = @_; + if (defined $self->[1]) { + if (defined $self->[2]) { + $self->[1]->print($self->[2], sprintf($format, @list), $self->[0]); + } else { + $self->[1]->print(sprintf($format, @list), $self->[0]); + } + } else { + Irssi::print(sprintf($format, @list), $self->[0]); + } +} + +sub READ { + croak "Cannot [sys]read() from an Irssi handle" +} + +sub READLINE { + croak "Cannot readline() from an Irssi handle" +} + +sub GETC { + croak "Cannot getc() from an Irssi handle" +} + +sub CLOSE {} +sub UNTIE {} +sub DESTROY {} + +# End of TIEHANDLE methods + +# Handle creators + +sub create_window_handle { + my ($object, $level) = @_; + $object = eval 'active_win' unless defined $object; + $level = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level; + croak 'Usage: create_window_handle([$window[, $level]])' + if ref $object !~ /::Window$/i; + no strict 'refs'; + my $symref = 'Irssi::Handles::' . $object . '/' . $level; + my $fh = \*{$symref}; + tie *{$symref}, __PACKAGE__, $level, $object; + return $fh; +} + +sub create_server_handle { + my ($object, $target, $level) = @_; + croak 'Usage: create_server_handle($server, $target[, $level])' + if not defined $object + or not defined $target + or ref $object !~ /::Server$/i; + $level = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level; + no strict 'refs'; + my $symref = 'Irssi::Handles::' . $object . '/' . $target . '/' . $level; + my $fh = \*{$symref}; + tie *{$symref}, __PACKAGE__, $level, $object, $target; + return $fh; +} + +# Object interface for create_server_handle + +sub Irssi::Server::create_handle { + goto &Irssi::create_server_handle; +} + +# Normal Irssi.pm stuff + +sub VERSION { + my $version = $_[1]; + die "This script requires irssi version $version or later" + if ($version > version()); +} + +sub EXPORT_ALL () { + my %exports = map { $_ => undef } @EXPORT, @EXPORT_OK; + no strict 'refs'; + for (keys %Irssi::) { + if (/^MSGLEVEL_/) { + (my $short = $_) =~ s///; + next if exists $exports{"*$short"}; + tie *{ $short }, __PACKAGE__, &$_(); + push @EXPORT, "*$short"; + } else { + next if exists $exports{$_}; + push @EXPORT_OK, $_ if /[a-z]/ && defined *{$_}{CODE}; + } + } + + tie *DEFAULT, __PACKAGE__, MSGLEVEL_CLIENTCRAP(); + select DEFAULT; +} + +sub in_irssi { + return $in_irssi; +} + +$VERSION = "0.9"; + +require Exporter; +require DynaLoader; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(INPUT_READ INPUT_WRITE + MSGLEVEL_CRAP MSGLEVEL_MSGS MSGLEVEL_PUBLIC MSGLEVEL_NOTICES + MSGLEVEL_SNOTES MSGLEVEL_CTCPS MSGLEVEL_ACTIONS MSGLEVEL_JOINS + MSGLEVEL_PARTS MSGLEVEL_QUITS MSGLEVEL_KICKS MSGLEVEL_MODES + MSGLEVEL_TOPICS MSGLEVEL_WALLOPS MSGLEVEL_INVITES MSGLEVEL_NICKS + MSGLEVEL_DCC MSGLEVEL_DCCMSGS MSGLEVEL_CLIENTNOTICE MSGLEVEL_CLIENTCRAP + MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT + MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG MSGLEVEL_HIDDEN +); + +my $static = 0; + +eval { + $static = Irssi::Core::is_static(); +}; +$in_irssi = $@ ? 0 : 1; + +if (!in_irssi()) { + print STDERR "Warning: This script should be run inside irssi\n"; +} else { + bootstrap Irssi $VERSION if (!$static); + + @Irssi::Channel::ISA = qw(Irssi::Windowitem); + @Irssi::Query::ISA = qw(Irssi::Windowitem); + @Irssi::UI::Exec::ISA = qw(Irssi::Windowitem); + @Irssi::Chatnet::ISA = qw(); + @Irssi::Nick::ISA = qw(); + + Irssi::init(); + + Irssi::EXPORT_ALL(); +} + +1; diff --git a/src/perl/common/Irssi.xs b/src/perl/common/Irssi.xs new file mode 100644 index 0000000..dc354bb --- /dev/null +++ b/src/perl/common/Irssi.xs @@ -0,0 +1,44 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +static int initialized = FALSE; + +void perl_expando_init(void); +void perl_expando_deinit(void); + +void perl_settings_init(void); +void perl_settings_deinit(void); + +MODULE = Irssi PACKAGE = Irssi + +PROTOTYPES: ENABLE + +void +init() +CODE: + if (initialized) return; + perl_api_version_check("Irssi"); + initialized = TRUE; + + perl_settings_init(); + perl_expando_init(); + +void +deinit() +CODE: + if (!initialized) return; + perl_expando_deinit(); + perl_settings_deinit(); + initialized = FALSE; + +BOOT: + irssi_boot(Channel); + irssi_boot(Core); + irssi_boot(Expando); + irssi_boot(Ignore); + irssi_boot(Log); + irssi_boot(Masks); + irssi_boot(Query); + irssi_boot(Rawlog); + irssi_boot(Server); + irssi_boot(Settings); diff --git a/src/perl/common/Log.xs b/src/perl/common/Log.xs new file mode 100644 index 0000000..532095f --- /dev/null +++ b/src/perl/common/Log.xs @@ -0,0 +1,69 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Log PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +logs() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = logs; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Log"))); + } + +Irssi::Log +log_create_rec(fname, level) + char *fname + int level + +Irssi::Log +log_find(fname) + char *fname + +#******************************* +MODULE = Irssi::Log PACKAGE = Irssi::Log PREFIX = log_ +#******************************* + +void +log_item_add(log, type, name, servertag) + Irssi::Log log + int type + char *name + char *servertag + +void +log_item_destroy(log, item) + Irssi::Log log + Irssi::Logitem item + +Irssi::Logitem +log_item_find(log, type, item, servertag) + Irssi::Log log + int type + char *item + char *servertag + +void +log_update(log) + Irssi::Log log + +void +log_close(log) + Irssi::Log log + +void +log_write_rec(log, str, level, now = -1) + Irssi::Log log + char *str + int level + time_t now + +void +log_start_logging(log) + Irssi::Log log + +void +log_stop_logging(log) + Irssi::Log log diff --git a/src/perl/common/Makefile.PL.in b/src/perl/common/Makefile.PL.in new file mode 100644 index 0000000..2b087d0 --- /dev/null +++ b/src/perl/common/Makefile.PL.in @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker;our $AM_DEFAULT_VERBOSITY='@AM_DEFAULT_VERBOSITY@';require "@top_srcdir@/src/perl/Makefile_silent.pm"; + +WriteMakefile('NAME' => 'Irssi', + 'LIBS' => '', + 'OBJECT' => '$(O_FILES)', + 'INC' => '-I../../.. @GLIB_CFLAGS@', + 'VERSION_FROM' => '@srcdir@/Irssi.pm'); diff --git a/src/perl/common/Masks.xs b/src/perl/common/Masks.xs new file mode 100644 index 0000000..9612911 --- /dev/null +++ b/src/perl/common/Masks.xs @@ -0,0 +1,62 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Masks PACKAGE = Irssi +PROTOTYPES: ENABLE + +int +mask_match(mask, nick, user, host) + char *mask + char *nick + char *user + char *host +CODE: + RETVAL = mask_match(NULL, mask, nick, user, host); +OUTPUT: + RETVAL + +int +mask_match_address(mask, nick, address) + char *mask + char *nick + char *address +CODE: + RETVAL = mask_match_address(NULL, mask, nick, address); +OUTPUT: + RETVAL + +int +masks_match(masks, nick, address) + char *masks + char *nick + char *address +CODE: + RETVAL = masks_match(NULL, masks, nick, address); +OUTPUT: + RETVAL + +#******************************* +MODULE = Irssi::Masks PACKAGE = Irssi::Server +#******************************* + +int +mask_match(server, mask, nick, user, host) + Irssi::Server server + char *mask + char *nick + char *user + char *host + +int +mask_match_address(server, mask, nick, address) + Irssi::Server server + char *mask + char *nick + char *address + +int +masks_match(server, masks, nick, address) + Irssi::Server server + char *masks + char *nick + char *address diff --git a/src/perl/common/Query.xs b/src/perl/common/Query.xs new file mode 100644 index 0000000..9d8cd52 --- /dev/null +++ b/src/perl/common/Query.xs @@ -0,0 +1,58 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Query PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +queries() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = queries; tmp != NULL; tmp = tmp->next) { + QUERY_REC *rec = tmp->data; + + XPUSHs(sv_2mortal(iobject_bless(rec))); + } + +Irssi::Query +query_find(nick) + char *nick +CODE: + RETVAL = query_find(NULL, nick); +OUTPUT: + RETVAL + +#******************************* +MODULE = Irssi::Query PACKAGE = Irssi::Server +#******************************* + +void +queries(server) + Irssi::Server server +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = server->queries; tmp != NULL; tmp = tmp->next) { + QUERY_REC *rec = tmp->data; + + XPUSHs(sv_2mortal(iobject_bless(rec))); + } + +Irssi::Query +query_find(server, nick) + Irssi::Server server + char *nick + +#******************************* +MODULE = Irssi::Query PACKAGE = Irssi::Query PREFIX = query_ +#******************************* + +void +query_destroy(query) + Irssi::Query query + +void +query_change_server(query, server) + Irssi::Query query + Irssi::Server server diff --git a/src/perl/common/Rawlog.xs b/src/perl/common/Rawlog.xs new file mode 100644 index 0000000..3c946c7 --- /dev/null +++ b/src/perl/common/Rawlog.xs @@ -0,0 +1,59 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Rawlog PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +rawlog_set_size(lines) + int lines + +Irssi::Rawlog +rawlog_create() + +#******************************* +MODULE = Irssi::Rawlog PACKAGE = Irssi::Rawlog PREFIX = rawlog_ +#******************************* + +void +rawlog_get_lines(rawlog) + Irssi::Rawlog rawlog +PREINIT: + GList *tmp; +PPCODE: + for (tmp = rawlog->lines->head; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(new_pv(tmp->data))); + } + +void +rawlog_destroy(rawlog) + Irssi::Rawlog rawlog + +void +rawlog_input(rawlog, str) + Irssi::Rawlog rawlog + char *str + +void +rawlog_output(rawlog, str) + Irssi::Rawlog rawlog + char *str + +void +rawlog_redirect(rawlog, str) + Irssi::Rawlog rawlog + char *str + +void +rawlog_open(rawlog, fname) + Irssi::Rawlog rawlog + char *fname + +void +rawlog_close(rawlog) + Irssi::Rawlog rawlog + +void +rawlog_save(rawlog, fname) + Irssi::Rawlog rawlog + char *fname diff --git a/src/perl/common/Server.xs b/src/perl/common/Server.xs new file mode 100644 index 0000000..60878a6 --- /dev/null +++ b/src/perl/common/Server.xs @@ -0,0 +1,119 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Server PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +servers() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = servers; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(iobject_bless((SERVER_REC *) tmp->data))); + } + +void +reconnects() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = reconnects; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Reconnect"))); + } + +void +chatnets() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = chatnets; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(iobject_bless((CHATNET_REC *) tmp->data))); + } + +Irssi::Connect +server_create_conn(chat_type, dest, port, chatnet=NULL, password=NULL, nick=NULL) + int chat_type + char *dest + int port + char *chatnet + char *password + char *nick + +Irssi::Server +server_find_tag(tag) + char *tag + +Irssi::Server +server_find_chatnet(chatnet) + char *chatnet + +Irssi::Chatnet +chatnet_find(name) + char *name + +#******************************* +MODULE = Irssi::Server PACKAGE = Irssi::Server PREFIX = server_ +#******************************* + +void +server_disconnect(server) + Irssi::Server server + +void +server_ref(server) + Irssi::Server server + +void +server_unref(server) + Irssi::Server server + +int +isnickflag(server, flag) + Irssi::Server server + char flag +CODE: + RETVAL = server->isnickflag(server, flag); +OUTPUT: + RETVAL + +int +ischannel(server, data) + Irssi::Server server + char *data +CODE: + RETVAL = server->ischannel(server, data); +OUTPUT: + RETVAL + +char * +get_nick_flags(server) + Irssi::Server server +CODE: + RETVAL = (char *) server->get_nick_flags(server); +OUTPUT: + RETVAL + +void +send_message(server, target, msg, target_type) + Irssi::Server server + char *target + char *msg + int target_type +CODE: + server->send_message(server, target, msg, target_type); + +void +server_meta_stash(server, meta_key, meta_value) + Irssi::Server server + char *meta_key + char *meta_value + +char * +server_meta_stash_find(server, meta_key) + Irssi::Server server + char *meta_key +CODE: + RETVAL = (char *) server_meta_stash_find(server, meta_key); +OUTPUT: + RETVAL diff --git a/src/perl/common/Settings.xs b/src/perl/common/Settings.xs new file mode 100644 index 0000000..0f17241 --- /dev/null +++ b/src/perl/common/Settings.xs @@ -0,0 +1,215 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/misc.h> + +static GHashTable *perl_settings; + +static void perl_settings_add(const char *key) +{ + PERL_SCRIPT_REC *script; + GSList *list; + + script = perl_script_find_package(perl_get_package()); + g_return_if_fail(script != NULL); + + list = g_hash_table_lookup(perl_settings, script); + list = g_slist_append(list, g_strdup(key)); + g_hash_table_insert(perl_settings, script, list); +} + +static void perl_settings_remove(const char *key) +{ + PERL_SCRIPT_REC *script; + GSList *list, *pos; + + script = perl_script_find_package(perl_get_package()); + g_return_if_fail(script != NULL); + + list = g_hash_table_lookup(perl_settings, script); + pos = i_slist_find_icase_string(list, key); + if (pos != NULL) { + list = g_slist_remove(list, pos->data); + g_hash_table_insert(perl_settings, script, list); + } +} + +static void perl_settings_free(PERL_SCRIPT_REC *script, GSList *list) +{ + g_slist_foreach(list, (GFunc) g_free, NULL); + g_slist_free(list); +} + +static void sig_script_destroyed(PERL_SCRIPT_REC *script) +{ + GSList *list; + + list = g_hash_table_lookup(perl_settings, script); + if (list != NULL) { + g_slist_foreach(list, (GFunc) settings_remove, NULL); + perl_settings_free(script, list); + g_hash_table_remove(perl_settings, script); + } +} + +void perl_settings_init(void) +{ + perl_settings = g_hash_table_new((GHashFunc) g_direct_hash, + (GCompareFunc) g_direct_equal); + signal_add("script destroyed", (SIGNAL_FUNC) sig_script_destroyed); +} + +void perl_settings_deinit(void) +{ + signal_remove("script destroyed", (SIGNAL_FUNC) sig_script_destroyed); + + g_hash_table_foreach(perl_settings, (GHFunc) perl_settings_free, NULL); + g_hash_table_destroy(perl_settings); +} + +MODULE = Irssi::Settings PACKAGE = Irssi +PROTOTYPES: ENABLE + +SV * +settings_get_str(key) + char *key +PREINIT: + const char *str; +CODE: + str = settings_get_str(key); + RETVAL = new_pv(str); +OUTPUT: + RETVAL + +int +settings_get_int(key) + char *key + +int +settings_get_bool(key) + char *key + +int +settings_get_time(key) + char *key + +int +settings_get_level(key) + char *key + +int +settings_get_level_negative(key) + char *key + +int +settings_get_size(key) + char *key + +int +settings_get_choice(key) + char *key + +void +settings_set_str(key, value) + char *key + char *value + +void +settings_set_int(key, value) + char *key + int value + +void +settings_set_bool(key, value) + char *key + int value + +int +settings_set_time(key, value) + char *key + char *value + +int +settings_set_level(key, value) + char *key + char *value + +int +settings_set_size(key, value) + char *key + char *value + +int +settings_set_choice(key, value) + char *key + char *value + +void +settings_add_str(section, key, def) + char *section + char *key + char *def +CODE: + perl_settings_add(key); + settings_add_str_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_int(section, key, def) + char *section + char *key + int def +CODE: + perl_settings_add(key); + settings_add_int_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_bool(section, key, def) + char *section + char *key + int def +CODE: + perl_settings_add(key); + settings_add_bool_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_time(section, key, def) + char *section + char *key + char *def +CODE: + perl_settings_add(key); + settings_add_time_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_level(section, key, def) + char *section + char *key + char *def +CODE: + perl_settings_add(key); + settings_add_level_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_size(section, key, def) + char *section + char *key + char *def +CODE: + perl_settings_add(key); + settings_add_size_module(MODULE_NAME"/scripts", section, key, def); + +void +settings_add_choice(section, key, def, choices) + char *section + char *key + int def + char *choices +CODE: + perl_settings_add(key); + settings_add_choice_module(MODULE_NAME "/scripts", section, key, def, choices); + +void +settings_remove(key) + char *key +CODE: + perl_settings_remove(key); + settings_remove(key); diff --git a/src/perl/common/meson.build b/src/perl/common/meson.build new file mode 100644 index 0000000..4162756 --- /dev/null +++ b/src/perl/common/meson.build @@ -0,0 +1,40 @@ + +libperl_Irssi_a = shared_module('Irssi', + [ xsubpp.process( + files( + 'Channel.xs', + 'Core.xs', + 'Expando.xs', + 'Ignore.xs', + 'Irssi.xs', + 'Log.xs', + 'Masks.xs', + 'Query.xs', + 'Rawlog.xs', + 'Server.xs', + 'Settings.xs', + ) + ) ] + + files( + 'module.h', + ) + + [ irssi_version_h ], + name_prefix : '', + name_suffix : perl_module_suffix, + install : true, + install_dir : perlmoddir / 'auto' / 'Irssi', + include_directories : rootinc, + implicit_include_directories : true, + dependencies : dep + [ perl_dep ], + link_with : dl_cross_perl_core, +) + +install_headers( + files( + 'Irssi.pm', + ), + install_dir : perlmoddir, +) + +# 'Makefile.PL.in', +# 'typemap', diff --git a/src/perl/common/module.h b/src/perl/common/module.h new file mode 100644 index 0000000..92a712f --- /dev/null +++ b/src/perl/common/module.h @@ -0,0 +1,45 @@ +#define NEED_PERL_H +#define HAVE_CONFIG_H +#include <irssi/src/perl/module.h> +#include <XSUB.h> + +#include <irssi/src/core/network.h> +#include <irssi/src/core/levels.h> +#include <irssi/src/core/commands.h> +#include <irssi/src/core/log.h> +#include <irssi/src/core/rawlog.h> +#include <irssi/src/core/ignore.h> +#include <irssi/src/core/settings.h> +#include <irssi/src/core/masks.h> +#include <irssi/src/core/special-vars.h> +#include <irssi/src/core/window-item-def.h> + +#include <irssi/src/core/chat-protocols.h> +#include <irssi/src/core/chatnets.h> +#include <irssi/src/core/servers.h> +#include <irssi/src/core/servers-reconnect.h> +#include <irssi/src/core/servers-setup.h> +#include <irssi/src/core/channels.h> +#include <irssi/src/core/queries.h> +#include <irssi/src/core/nicklist.h> + +#include <irssi/src/perl/perl-core.h> +#include <irssi/src/perl/perl-common.h> +#include <irssi/src/perl/perl-signals.h> +#include <irssi/src/perl/perl-sources.h> + +typedef COMMAND_REC *Irssi__Command; +typedef LOG_REC *Irssi__Log; +typedef LOG_ITEM_REC *Irssi__Logitem; +typedef RAWLOG_REC *Irssi__Rawlog; +typedef IGNORE_REC *Irssi__Ignore; +typedef MODULE_REC *Irssi__Module; +typedef WI_ITEM_REC *Irssi__Windowitem; + +typedef CHATNET_REC *Irssi__Chatnet; +typedef SERVER_REC *Irssi__Server; +typedef SERVER_CONNECT_REC *Irssi__Connect; +typedef RECONNECT_REC *Irssi__Reconnect; +typedef CHANNEL_REC *Irssi__Channel; +typedef QUERY_REC *Irssi__Query; +typedef NICK_REC *Irssi__Nick; diff --git a/src/perl/common/typemap b/src/perl/common/typemap new file mode 100644 index 0000000..9b6c666 --- /dev/null +++ b/src/perl/common/typemap @@ -0,0 +1,32 @@ +TYPEMAP +Irssi::Chatnet T_IrssiObj +Irssi::Server T_IrssiObj +Irssi::Connect T_IrssiObj +Irssi::Reconnect T_PlainObj +Irssi::Channel T_IrssiObj +Irssi::Query T_IrssiObj +Irssi::Command T_PlainObj +Irssi::Nick T_IrssiObj +Irssi::Ignore T_PlainObj +Irssi::Log T_PlainObj +Irssi::Logitem T_PlainObj +Irssi::Rawlog T_PlainObj +Irssi::Module T_PlainObj +Irssi::Windowitem T_IrssiObj + +INPUT + +T_IrssiObj + $var = irssi_ref_object($arg) + +T_PlainObj + $var = irssi_ref_object($arg) + +OUTPUT + +T_IrssiObj + $arg = iobject_bless((SERVER_REC *)$var); + +T_PlainObj + $arg = plain_bless($var, \"$ntype\"); + diff --git a/src/perl/get-signals.pl b/src/perl/get-signals.pl new file mode 100755 index 0000000..f7675f1 --- /dev/null +++ b/src/perl/get-signals.pl @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +print "/*\n"; +print " * Autogenerated by get-signals.pl from ../../doc/signals.txt,\n"; +print " * do not edit.\n"; +print " */\n\n"; +print "static PERL_SIGNAL_ARGS_REC perl_signal_args[] =\n{\n"; + +while (<>) { + chomp; + + next if (!/^ "([^"]*)"(<.*>)?(?:,\s*(.*))?/); + next if (/\.\.\./); + next if (/\(/); + + $signal = $1; + $_ = $3; + + s/GList \* of ([^,]*)s/glistptr_\1/g; + s/GSList of ([^,]*)s/gslist_\1/g; + + s/GString \*[^,]*/gstring/g; + + s/char \*[^,]*/string/g; + s/ulong \*[^,]*/ulongptr/g; + s/int \*[^,]*/intptr/g; + s/int [^,]*/int/g; + + + my %map = ( + # core + CHATNET_REC => 'iobject', + SERVER_REC => 'iobject', + RECONNECT_REC => 'iobject', + CHANNEL_REC => 'iobject', + QUERY_REC => 'iobject', + COMMAND_REC => 'Irssi::Command', + NICK_REC => 'iobject', + LOG_REC => 'Irssi::Log', + RAWLOG_REC => 'Irssi::Rawlog', + IGNORE_REC => 'Irssi::Ignore', + MODULE_REC => 'Irssi::Module', + TLS_REC => 'iobject', + + # irc + BAN_REC => 'Irssi::Irc::Ban', + NETSPLIT_REC => 'Irssi::Irc::Netsplit', + NETSPLIT_SERVER_REC => 'Irssi::Irc::Netsplitserver', + + # irc modules + DCC_REC => 'siobject', + AUTOIGNORE_REC => 'Irssi::Irc::Autoignore', + NOTIFYLIST_REC => 'Irssi::Irc::Notifylist', + CLIENT_REC => 'Irssi::Irc::Client', + + # fe-common + THEME_REC => 'Irssi::UI::Theme', + KEYINFO_REC => 'Irssi::UI::Keyinfo', + PROCESS_REC => 'Irssi::UI::Process', + TEXT_DEST_REC => 'Irssi::UI::TextDest', + LINE_INFO_META_REC => 'Irssi::UI::LineInfoMeta', + WINDOW_REC => 'Irssi::UI::Window', + WI_ITEM_REC => 'iobject', + + # fe-text + TEXTBUFFER_VIEW_REC => 'Irssi::TextUI::TextBufferView', + LINE_REC => 'Irssi::TextUI::Line', + + # perl + PERL_SCRIPT_REC => 'Irssi::Script', + ); + my $k = join '|', sort { length $b <=> length $a } keys %map; + s/($k)[^,]*/$map{$1}/g; + + s/([\w\*:]+)(,|$)/"\1"\2/g; + if ($_ eq "") { + print " { \"$signal\", { NULL } },\n"; + } else { + print " { \"$signal\", { $_, NULL } },\n"; + } +} + +print "\n { NULL }\n};\n"; diff --git a/src/perl/irc/Channel.xs b/src/perl/irc/Channel.xs new file mode 100644 index 0000000..782fa1d --- /dev/null +++ b/src/perl/irc/Channel.xs @@ -0,0 +1,64 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Channel PACKAGE = Irssi::Irc PREFIX = irc_ +PROTOTYPES: ENABLE + +char * +irc_get_mask(nick, address, flags) + char *nick + char *address + int flags + +int +MASK_NICK() +CODE: + RETVAL = IRC_MASK_NICK; +OUTPUT: + RETVAL + +int +MASK_USER() +CODE: + RETVAL = IRC_MASK_USER; +OUTPUT: + RETVAL + +int +MASK_HOST() +CODE: + RETVAL = IRC_MASK_HOST; +OUTPUT: + RETVAL + +int +MASK_DOMAIN() +CODE: + RETVAL = IRC_MASK_DOMAIN; +OUTPUT: + RETVAL + +MODULE = Irssi::Irc::Channel PACKAGE = Irssi::Irc::Channel PREFIX = irc_ + +void +bans(channel) + Irssi::Irc::Channel channel +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = channel->banlist; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Irc::Ban"))); + } + +Irssi::Irc::Nick +irc_nick_insert(channel, nick, op, halfop, voice, send_massjoin) + Irssi::Irc::Channel channel + char *nick + int op + int halfop + int voice + int send_massjoin +CODE: + RETVAL = irc_nicklist_insert(channel, nick, op, halfop, voice, send_massjoin, NULL); +OUTPUT: + RETVAL diff --git a/src/perl/irc/Client.xs b/src/perl/irc/Client.xs new file mode 100644 index 0000000..05616af --- /dev/null +++ b/src/perl/irc/Client.xs @@ -0,0 +1,6 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Client PACKAGE = Irssi::Irc +PROTOTYPES: ENABLE + diff --git a/src/perl/irc/Ctcp.xs b/src/perl/irc/Ctcp.xs new file mode 100644 index 0000000..3497887 --- /dev/null +++ b/src/perl/irc/Ctcp.xs @@ -0,0 +1,21 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/irc/core/ctcp.h> + +MODULE = Irssi::Irc::Ctcp PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +ctcp_register(name) + char *name + +void +ctcp_unregister(name) + char *name + +MODULE = Irssi::Irc::Ctcp PACKAGE = Irssi::Irc::Server PREFIX = irc_server_ + +void +ctcp_send_reply(server, data) + Irssi::Irc::Server server + char *data diff --git a/src/perl/irc/Dcc.xs b/src/perl/irc/Dcc.xs new file mode 100644 index 0000000..c078a1b --- /dev/null +++ b/src/perl/irc/Dcc.xs @@ -0,0 +1,103 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Dcc PACKAGE = Irssi::Irc +PROTOTYPES: ENABLE + +void +dccs() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = dcc_conns; tmp != NULL; tmp = tmp->next) + XPUSHs(sv_2mortal(simple_iobject_bless((DCC_REC *) tmp->data))); + +void +dcc_register_type(type) + char *type + +void +dcc_unregister_type(type) + char *type + +int +dcc_str2type(str) + char *str + +char * +dcc_type2str(type) + int type +CODE: + RETVAL = (char *) module_find_id_str("DCC", type); +OUTPUT: + RETVAL + +Irssi::Irc::Dcc +dcc_find_request_latest(type) + int type + +Irssi::Irc::Dcc +dcc_find_request(type, nick, arg) + int type + char *nick + char *arg + +Irssi::Irc::Dcc::Chat +dcc_chat_find_id(id) + char *id + +void +dcc_chat_send(dcc, data) + Irssi::Irc::Dcc::Chat dcc + char *data + +void +dcc_ctcp_message(server, target, chat, notice, msg) + Irssi::Irc::Server server + char *target + Irssi::Irc::Dcc::Chat chat + int notice + char *msg + +void +dcc_get_download_path(fname) + char *fname +PREINIT: + char *ret; +PPCODE: + ret = dcc_get_download_path(fname); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +#******************************* +MODULE = Irssi::Irc::Dcc PACKAGE = Irssi::Irc::Dcc PREFIX = dcc_ +#******************************* + +void +dcc_init_rec(dcc, server, chat, nick, arg) + Irssi::Irc::Dcc dcc + Irssi::Irc::Server server + Irssi::Irc::Dcc::Chat chat + char *nick + char *arg + +void +dcc_destroy(dcc) + Irssi::Irc::Dcc dcc + +void +dcc_close(dcc) + Irssi::Irc::Dcc dcc + +void +dcc_reject(dcc, server) + Irssi::Irc::Dcc dcc + Irssi::Irc::Server server + +#******************************* +MODULE = Irssi::Irc::Dcc PACKAGE = Irssi::Windowitem PREFIX = item_ +#******************************* + +Irssi::Irc::Dcc::Chat +item_get_dcc(item) + Irssi::Windowitem item diff --git a/src/perl/irc/Irc.pm b/src/perl/irc/Irc.pm new file mode 100644 index 0000000..1d95462 --- /dev/null +++ b/src/perl/irc/Irc.pm @@ -0,0 +1,26 @@ +# +# Perl interface to irssi functions. +# + +package Irssi::Irc; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +$VERSION = "0.9"; + +require Exporter; +require DynaLoader; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +bootstrap Irssi::Irc $VERSION if (!Irssi::Core::is_static()); + +Irssi::Irc::init(); + +Irssi::EXPORT_ALL(); + +1; + diff --git a/src/perl/irc/Irc.xs b/src/perl/irc/Irc.xs new file mode 100644 index 0000000..33be93d --- /dev/null +++ b/src/perl/irc/Irc.xs @@ -0,0 +1,283 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +static int initialized = FALSE; + +static void perl_irc_chatnet_fill_hash(HV *hv, IRC_CHATNET_REC *chatnet) +{ + perl_chatnet_fill_hash(hv, (CHATNET_REC *) chatnet); + (void) hv_store(hv, "usermode", 8, new_pv(chatnet->usermode), 0); +} + +static void perl_irc_connect_fill_hash(HV *hv, IRC_SERVER_CONNECT_REC *conn) +{ + perl_connect_fill_hash(hv, (SERVER_CONNECT_REC *) conn); + (void) hv_store(hv, "alternate_nick", 14, new_pv(conn->alternate_nick), 0); +} + +static void perl_irc_server_fill_hash(HV *hv, IRC_SERVER_REC *server) +{ + AV *av; + HV *hv_; + GSList *tmp; + GHashTableIter iter; + gpointer key_, val_; + + perl_irc_connect_fill_hash(hv, server->connrec); + perl_server_fill_hash(hv, (SERVER_REC *) server); + + (void) hv_store(hv, "real_address", 12, new_pv(server->real_address), 0); + (void) hv_store(hv, "usermode", 8, new_pv(server->usermode), 0); + (void) hv_store(hv, "userhost", 8, new_pv(server->userhost), 0); + + (void) hv_store(hv, "max_message_len", 15, newSViv(server->max_message_len), 0); + + (void) hv_store(hv, "max_cmds_at_once", 16, newSViv(server->max_cmds_at_once), 0); + (void) hv_store(hv, "cmd_queue_speed", 15, newSViv(server->cmd_queue_speed), 0); + (void) hv_store(hv, "max_query_chans", 15, newSViv(server->max_query_chans), 0); + + (void) hv_store(hv, "max_kicks_in_cmd", 16, newSViv(server->max_kicks_in_cmd), 0); + (void) hv_store(hv, "max_msgs_in_cmd", 15, newSViv(server->max_msgs_in_cmd), 0); + (void) hv_store(hv, "max_modes_in_cmd", 16, newSViv(server->max_modes_in_cmd), 0); + (void) hv_store(hv, "max_whois_in_cmd", 16, newSViv(server->max_whois_in_cmd), 0); + (void) hv_store(hv, "isupport_sent", 13, newSViv(server->isupport_sent), 0); + + (void) hv_store(hv, "cap_complete", 12, newSViv(server->cap_complete), 0); + (void) hv_store(hv, "sasl_success", 12, newSViv(server->sasl_success), 0); + + if (server->cap_supported != NULL) { + hv_ = newHV(); + g_hash_table_iter_init(&iter, server->cap_supported); + while (g_hash_table_iter_next(&iter, &key_, &val_)) { + char *key = (char *)key_; + char *val = (char *)val_; + hv_store(hv_, key, strlen(key), new_pv(val), 0); + } + (void) hv_store(hv, "cap_supported", 13, newRV_noinc((SV*)hv_), 0); + } + + av = newAV(); + for (tmp = server->cap_active; tmp != NULL; tmp = tmp->next) + av_push(av, new_pv(tmp->data)); + (void) hv_store(hv, "cap_active", 10, newRV_noinc((SV*)av), 0); +} + +static void perl_ban_fill_hash(HV *hv, BAN_REC *ban) +{ + (void) hv_store(hv, "ban", 3, new_pv(ban->ban), 0); + (void) hv_store(hv, "setby", 5, new_pv(ban->setby), 0); + (void) hv_store(hv, "time", 4, newSViv(ban->time), 0); +} + +static void perl_dcc_fill_hash(HV *hv, DCC_REC *dcc) +{ + (void) hv_store(hv, "type", 4, new_pv(dcc_type2str(dcc->type)), 0); + (void) hv_store(hv, "orig_type", 9, new_pv(dcc_type2str(dcc->orig_type)), 0); + (void) hv_store(hv, "created", 7, newSViv(dcc->created), 0); + + (void) hv_store(hv, "server", 6, iobject_bless(dcc->server), 0); + (void) hv_store(hv, "servertag", 9, new_pv(dcc->servertag), 0); + (void) hv_store(hv, "mynick", 6, new_pv(dcc->mynick), 0); + (void) hv_store(hv, "nick", 4, new_pv(dcc->nick), 0); + + (void) hv_store(hv, "chat", 4, simple_iobject_bless(dcc->chat), 0); + (void) hv_store(hv, "target", 6, new_pv(dcc->target), 0); + (void) hv_store(hv, "arg", 3, new_pv(dcc->arg), 0); + + (void) hv_store(hv, "addr", 4, new_pv(dcc->addrstr), 0); + (void) hv_store(hv, "port", 4, newSViv(dcc->port), 0); + + (void) hv_store(hv, "starttime", 9, newSViv(dcc->starttime), 0); + (void) hv_store(hv, "transfd", 7, newSViv(dcc->transfd), 0); +} + +static void perl_dcc_chat_fill_hash(HV *hv, CHAT_DCC_REC *dcc) +{ + perl_dcc_fill_hash(hv, (DCC_REC *) dcc); + + (void) hv_store(hv, "id", 2, new_pv(dcc->id), 0); + (void) hv_store(hv, "mirc_ctcp", 9, newSViv(dcc->mirc_ctcp), 0); + (void) hv_store(hv, "connection_lost", 15, newSViv(dcc->connection_lost), 0); +} + +static void perl_dcc_file_fill_hash(HV *hv, FILE_DCC_REC *dcc) +{ + perl_dcc_fill_hash(hv, (DCC_REC *) dcc); + + (void) hv_store(hv, "size", 4, newSViv(dcc->size), 0); + (void) hv_store(hv, "skipped", 7, newSViv(dcc->skipped), 0); +} + +static void perl_dcc_get_fill_hash(HV *hv, GET_DCC_REC *dcc) +{ + perl_dcc_file_fill_hash(hv, (FILE_DCC_REC *) dcc); + + (void) hv_store(hv, "get_type", 8, newSViv(dcc->get_type), 0); + (void) hv_store(hv, "file", 4, new_pv(dcc->file), 0); + (void) hv_store(hv, "file_quoted", 11, newSViv(dcc->file_quoted), 0); +} + +static void perl_dcc_send_fill_hash(HV *hv, SEND_DCC_REC *dcc) +{ + perl_dcc_file_fill_hash(hv, (FILE_DCC_REC *) dcc); + + (void) hv_store(hv, "file_quoted", 11, newSViv(dcc->file_quoted), 0); + (void) hv_store(hv, "waitforend", 10, newSViv(dcc->waitforend), 0); + (void) hv_store(hv, "gotalldata", 10, newSViv(dcc->gotalldata), 0); +} + +static void perl_netsplit_fill_hash(HV *hv, NETSPLIT_REC *netsplit) +{ + AV *av; + GSList *tmp; + + (void) hv_store(hv, "nick", 4, new_pv(netsplit->nick), 0); + (void) hv_store(hv, "address", 7, new_pv(netsplit->address), 0); + (void) hv_store(hv, "destroy", 7, newSViv(netsplit->destroy), 0); + + (void) hv_store(hv, "server", 6, + plain_bless(netsplit->server, + "Irssi::Irc::Netsplitserver"), 0); + + av = newAV(); + for (tmp = netsplit->channels; tmp != NULL; tmp = tmp->next) { + av_push(av, plain_bless(tmp->data, + "Irssi::Irc::Netsplitchannel")); + } + (void) hv_store(hv, "channels", 8, newRV_noinc((SV*)av), 0); +} + +static void perl_netsplit_server_fill_hash(HV *hv, NETSPLIT_SERVER_REC *rec) +{ + (void) hv_store(hv, "server", 6, new_pv(rec->server), 0); + (void) hv_store(hv, "destserver", 10, new_pv(rec->destserver), 0); + (void) hv_store(hv, "count", 5, newSViv(rec->count), 0); +} + +static void perl_netsplit_channel_fill_hash(HV *hv, NETSPLIT_CHAN_REC *rec) +{ + (void) hv_store(hv, "name", 4, new_pv(rec->name), 0); + (void) hv_store(hv, "op", 2, newSViv(rec->op), 0); + (void) hv_store(hv, "halfop", 6, newSViv(rec->halfop), 0); + (void) hv_store(hv, "voice", 5, newSViv(rec->voice), 0); +} + +static void perl_notifylist_fill_hash(HV *hv, NOTIFYLIST_REC *notify) +{ + AV *av; + char **tmp; + + (void) hv_store(hv, "mask", 4, new_pv(notify->mask), 0); + (void) hv_store(hv, "away_check", 10, newSViv(notify->away_check), 0); + + av = newAV(); + if (notify->ircnets != NULL) { + for (tmp = notify->ircnets; *tmp != NULL; tmp++) { + av_push(av, new_pv(*tmp)); + } + } + (void) hv_store(hv, "ircnets", 7, newRV_noinc((SV*)av), 0); +} + +static void perl_client_fill_hash(HV *hv, CLIENT_REC *client) +{ + (void) hv_store(hv, "nick", 4, new_pv(client->nick), 0); + (void) hv_store(hv, "addr", 4, new_pv(client->addr), 0); + (void) hv_store(hv, "proxy_address", 13, new_pv(client->proxy_address), 0); + (void) hv_store(hv, "server", 6, iobject_bless(client->server), 0); + (void) hv_store(hv, "pass_sent", 9, newSViv(client->pass_sent), 0); + (void) hv_store(hv, "user_sent", 9, newSViv(client->user_sent), 0); + (void) hv_store(hv, "connected", 9, newSViv(client->connected), 0); + (void) hv_store(hv, "want_ctcp", 9, newSViv(client->want_ctcp), 0); + (void) hv_store(hv, "multiplex", 9, newSViv(client->multiplex), 0); + (void) hv_store(hv, "ircnet", 6, new_pv(client->listen->ircnet), 0); +} + +static PLAIN_OBJECT_INIT_REC irc_plains[] = { + { "Irssi::Irc::Ban", (PERL_OBJECT_FUNC) perl_ban_fill_hash }, + { "Irssi::Irc::Dcc", (PERL_OBJECT_FUNC) perl_dcc_fill_hash }, + { "Irssi::Irc::Netsplit", (PERL_OBJECT_FUNC) perl_netsplit_fill_hash }, + { "Irssi::Irc::Netsplitserver", (PERL_OBJECT_FUNC) perl_netsplit_server_fill_hash }, + { "Irssi::Irc::Netsplitchannel", (PERL_OBJECT_FUNC) perl_netsplit_channel_fill_hash }, + { "Irssi::Irc::Notifylist", (PERL_OBJECT_FUNC) perl_notifylist_fill_hash }, + { "Irssi::Irc::Client", (PERL_OBJECT_FUNC) perl_client_fill_hash }, + + { NULL, NULL } +}; + +MODULE = Irssi::Irc PACKAGE = Irssi::Irc PREFIX = irc_ + +PROTOTYPES: ENABLE + +void +irc_parse_message_tags(tags) + char *tags +PREINIT: + HV *hv; + GHashTable *hash; + GHashTableIter iter; + char *key; + char *val; +PPCODE: + hv = newHV(); + hash = irc_parse_message_tags(tags); + g_hash_table_iter_init(&iter, hash); + while (g_hash_table_iter_next(&iter, (gpointer *) &key, (gpointer *) &val)) { + (void) hv_store(hv, key, strlen(key), new_pv(val), 0); + } + g_hash_table_destroy(hash); + XPUSHs(sv_2mortal(newRV_noinc((SV *) hv))); + +void +init() +PREINIT: + int chat_type; +CODE: + if (initialized) return; + perl_api_version_check("Irssi::Irc"); + initialized = TRUE; + + chat_type = chat_protocol_lookup("IRC"); + + irssi_add_object(module_get_uniq_id("CHATNET", 0), chat_type, "Irssi::Irc::Chatnet", + (PERL_OBJECT_FUNC) perl_irc_chatnet_fill_hash); + irssi_add_object(module_get_uniq_id("SERVER CONNECT", 0), + chat_type, "Irssi::Irc::Connect", + (PERL_OBJECT_FUNC) perl_irc_connect_fill_hash); + irssi_add_object(module_get_uniq_id("SERVER", 0), + chat_type, "Irssi::Irc::Server", + (PERL_OBJECT_FUNC) perl_irc_server_fill_hash); + irssi_add_object(module_get_uniq_id_str("DCC", "CHAT"), + 0, "Irssi::Irc::Dcc::Chat", + (PERL_OBJECT_FUNC) perl_dcc_chat_fill_hash); + irssi_add_object(module_get_uniq_id_str("DCC", "GET"), + 0, "Irssi::Irc::Dcc::Get", + (PERL_OBJECT_FUNC) perl_dcc_get_fill_hash); + irssi_add_object(module_get_uniq_id_str("DCC", "SEND"), + 0, "Irssi::Irc::Dcc::Send", + (PERL_OBJECT_FUNC) perl_dcc_send_fill_hash); + irssi_add_object(module_get_uniq_id_str("DCC", "SERVER"), + 0, "Irssi::Irc::Dcc::Server", + (PERL_OBJECT_FUNC) perl_dcc_send_fill_hash); + irssi_add_plains(irc_plains); + perl_eval_pv("@Irssi::Irc::Dcc::Chat::ISA = qw(Irssi::Irc::Dcc);\n" + "@Irssi::Irc::Dcc::Get::ISA = qw(Irssi::Irc::Dcc);\n" + "@Irssi::Irc::Dcc::Send::ISA = qw(Irssi::Irc::Dcc);\n" + "@Irssi::Irc::Dcc::Server::ISA = qw(Irssi::Irc::Dcc);\n", + TRUE); + +void +deinit() +CODE: + initialized = FALSE; + +BOOT: + irssi_boot(Irc__Channel); + irssi_boot(Irc__Ctcp); + irssi_boot(Irc__Dcc); + irssi_boot(Irc__Modes); + irssi_boot(Irc__Netsplit); + irssi_boot(Irc__Notifylist); + irssi_boot(Irc__Query); + irssi_boot(Irc__Server); + irssi_boot(Irc__Client); diff --git a/src/perl/irc/Makefile.PL.in b/src/perl/irc/Makefile.PL.in new file mode 100644 index 0000000..561308c --- /dev/null +++ b/src/perl/irc/Makefile.PL.in @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker;our $AM_DEFAULT_VERBOSITY='@AM_DEFAULT_VERBOSITY@';require "@top_srcdir@/src/perl/Makefile_silent.pm"; + +WriteMakefile('NAME' => 'Irssi::Irc', + 'LIBS' => '', + 'OBJECT' => '$(O_FILES)', + 'TYPEMAPS' => ['../common/typemap'], + 'INC' => '-I../../.. @GLIB_CFLAGS@', + 'VERSION_FROM' => '@srcdir@/Irc.pm'); diff --git a/src/perl/irc/Modes.xs b/src/perl/irc/Modes.xs new file mode 100644 index 0000000..a53391b --- /dev/null +++ b/src/perl/irc/Modes.xs @@ -0,0 +1,47 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Modes PACKAGE = Irssi::Irc +PROTOTYPES: ENABLE + +void +modes_join(server, old, mode, channel) + Irssi::Irc::Server server + char *old + char *mode + int channel +PREINIT: + char *ret; +PPCODE: + ret = modes_join(server, old, mode, channel); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +#******************************* +MODULE = Irssi::Irc::Modes PACKAGE = Irssi::Irc::Channel PREFIX = channel_ +#******************************* + +void +ban_get_mask(channel, nick, ban_type) + Irssi::Irc::Channel channel + char *nick + int ban_type +PREINIT: + char *ret; +PPCODE: + ret = ban_get_mask(channel, nick, ban_type); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +Irssi::Irc::Ban +banlist_add(channel, ban, nick, time) + Irssi::Irc::Channel channel + char *ban + char *nick + time_t time + +void +banlist_remove(channel, ban, nick) + Irssi::Irc::Channel channel + char *ban + char *nick diff --git a/src/perl/irc/Netsplit.xs b/src/perl/irc/Netsplit.xs new file mode 100644 index 0000000..9fafaf7 --- /dev/null +++ b/src/perl/irc/Netsplit.xs @@ -0,0 +1,18 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Netsplit PACKAGE = Irssi::Irc::Server +PROTOTYPES: ENABLE + +Irssi::Irc::Netsplit +netsplit_find(server, nick, address) + Irssi::Irc::Server server + char *nick + char *address + +Irssi::Irc::Netsplitchannel +netsplit_find_channel(server, nick, address, channel) + Irssi::Irc::Server server + char *nick + char *address + char *channel diff --git a/src/perl/irc/Notifylist.xs b/src/perl/irc/Notifylist.xs new file mode 100644 index 0000000..74747ba --- /dev/null +++ b/src/perl/irc/Notifylist.xs @@ -0,0 +1,59 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Notifylist PACKAGE = Irssi::Irc +PROTOTYPES: ENABLE + +void +notifies() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = notifies; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::Irc::Notifylist"))); + } + +Irssi::Irc::Notifylist +notifylist_add(mask, ircnets, away_check, idle_check_time) + char *mask + char *ircnets + int away_check + int idle_check_time +CODE: + if (idle_check_time != 0) + croak("Notify -idle has been removed"); + RETVAL = notifylist_add(mask, ircnets, away_check); +OUTPUT: + RETVAL + +void +notifylist_remove(mask) + char *mask + +Irssi::Irc::Server +notifylist_ison(nick, serverlist) + char *nick + char *serverlist + +Irssi::Irc::Notifylist +notifylist_find(mask, ircnet) + char *mask + char *ircnet + +#******************************* +MODULE = Irssi::Irc::Notifylist PACKAGE = Irssi::Irc::Server +#******************************* + +int +notifylist_ison_server(server, nick) + Irssi::Irc::Server server + char *nick + +#******************************* +MODULE = Irssi::Irc::Notifylist PACKAGE = Irssi::Irc::Notifylist PREFIX = notifylist_ +#******************************* + +int +notifylist_ircnets_match(rec, ircnet) + Irssi::Irc::Notifylist rec + char *ircnet diff --git a/src/perl/irc/Query.xs b/src/perl/irc/Query.xs new file mode 100644 index 0000000..e873d9a --- /dev/null +++ b/src/perl/irc/Query.xs @@ -0,0 +1,11 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +MODULE = Irssi::Irc::Query PACKAGE = Irssi::Irc::Server PREFIX = irc_ +PROTOTYPES: ENABLE + +Irssi::Irc::Query +irc_query_create(server_tag, nick, automatic) + char *server_tag + char *nick + int automatic diff --git a/src/perl/irc/Server.xs b/src/perl/irc/Server.xs new file mode 100644 index 0000000..63e3111 --- /dev/null +++ b/src/perl/irc/Server.xs @@ -0,0 +1,175 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/misc.h> + +static GSList *register_hash2list(HV *hv) +{ + HE *he; + GSList *list; + + if (hv == NULL) + return NULL; + + list = NULL; + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) { + I32 len; + char *key = hv_iterkey(he, &len); + int value = (int)SvIV(HeVAL(he)); + + list = g_slist_append(list, g_strdup(key)); + list = g_slist_append(list, GINT_TO_POINTER(value)); + } + return list; +} + +static GSList *event_hash2list(HV *hv) +{ + HE *he; + GSList *list; + + if (hv == NULL) + return NULL; + + list = NULL; + hv_iterinit(hv); + while ((he = hv_iternext(hv)) != NULL) { + I32 len; + char *key = hv_iterkey(he, &len); + char *value = SvPV_nolen(HeVAL(he)); + + list = g_slist_append(list, g_strdup(key)); + list = g_slist_append(list, g_strdup(value)); + } + return list; +} + +MODULE = Irssi::Irc::Server PACKAGE = Irssi::Irc::Server PREFIX = irc_server_ +PROTOTYPES: ENABLE + +void +irc_server_get_channels(server, rejoin_channels_mode = "") + Irssi::Irc::Server server + char *rejoin_channels_mode +PREINIT: + char *ret; + int mode; + SETTINGS_REC *setting; +PPCODE: + setting = settings_get_record("rejoin_channels_on_reconnect"); + mode = strarray_find(setting->choices, rejoin_channels_mode); + if (mode < 0) + mode = setting->default_value.v_int; + + ret = irc_server_get_channels(server, mode); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +void +send_raw(server, cmd) + Irssi::Irc::Server server + char *cmd +CODE: + irc_send_cmd(server, cmd); + +void +send_raw_now(server, cmd) + Irssi::Irc::Server server + char *cmd +CODE: + irc_send_cmd_now(server, cmd); + +void +send_raw_first(server, cmd) + Irssi::Irc::Server server + char *cmd +CODE: + irc_send_cmd_first(server, cmd); + +void +send_raw_later(server, cmd) + Irssi::Irc::Server server + char *cmd +CODE: + irc_send_cmd_later(server, cmd); + +void +send_raw_split(server, cmd, nickarg, max_nicks) + Irssi::Irc::Server server + char *cmd + int nickarg + int max_nicks +CODE: + irc_send_cmd_split(server, cmd, nickarg, max_nicks); + +MODULE = Irssi::Irc::Server PACKAGE = Irssi::Irc::Server PREFIX = server_ + +void +server_redirect_register(command, remote, timeout, start, stop, opt) + char *command + int remote + int timeout + SV *start + SV *stop + SV *opt +CODE: + server_redirect_register_list(command, remote, timeout, register_hash2list(hvref(start)), + register_hash2list(hvref(stop)), + register_hash2list(hvref(opt)), 1); + +void +server_redirect_event(server, command, count, arg, remote, failure_signal, signals) + Irssi::Irc::Server server + char *command + int count + char *arg + int remote + char *failure_signal + SV *signals +CODE: + server_redirect_event_list(server, command, count, *arg == '\0' ? NULL : arg, remote, + *failure_signal == '\0' ? NULL : failure_signal, + event_hash2list(hvref(signals))); + +char * +server_redirect_get_signal(server, prefix, event, args) + Irssi::Irc::Server server + char *prefix + char *event + char *args +CODE: + RETVAL = (char *) server_redirect_get_signal(server, prefix, event, args); +OUTPUT: + RETVAL + +char * +server_redirect_peek_signal(server, prefix, event, args) + Irssi::Irc::Server server + char *prefix + char *event + char *args +PREINIT: + int redirection; +CODE: + RETVAL = (char *) server_redirect_peek_signal(server, prefix, event, args, &redirection); +OUTPUT: + RETVAL + +char * +server_isupport(server, name) + Irssi::Irc::Server server + char *name +CODE: + RETVAL = (char *) g_hash_table_lookup(server->isupport, name); +OUTPUT: + RETVAL + +int +irc_server_cap_toggle(server, cap, enable) + Irssi::Irc::Server server + char *cap + int enable +CODE: + RETVAL = irc_cap_toggle(server, cap, enable); +OUTPUT: + RETVAL diff --git a/src/perl/irc/meson.build b/src/perl/irc/meson.build new file mode 100644 index 0000000..c83d4b4 --- /dev/null +++ b/src/perl/irc/meson.build @@ -0,0 +1,41 @@ +libperl_Irssi_Irc_a = shared_module('Irc', + [ xsubpp.process( + files( + 'Channel.xs', + 'Client.xs', + 'Ctcp.xs', + 'Dcc.xs', + 'Irc.xs', + 'Modes.xs', + 'Netsplit.xs', + 'Notifylist.xs', + 'Query.xs', + 'Server.xs', + ), + extra_args : [ + '-typemap', + '../common/typemap', + ], + ) ] + + files( + 'module.h', + ), + name_prefix : '', + name_suffix : perl_module_suffix, + install : true, + install_dir : perlmoddir / 'auto' / 'Irssi' / 'Irc', + include_directories : rootinc, + implicit_include_directories : true, + dependencies : dep + [ perl_dep ], + link_with : dl_cross_perl_core, +) + +install_headers( + files( + 'Irc.pm', + ), + install_dir : perlmoddir / 'Irssi', +) + +# 'Makefile.PL.in', +# 'typemap', diff --git a/src/perl/irc/module.h b/src/perl/irc/module.h new file mode 100644 index 0000000..3dcfb06 --- /dev/null +++ b/src/perl/irc/module.h @@ -0,0 +1,43 @@ +#include <irssi/src/perl/common/module.h> + +#include <irssi/src/irc/core/irc.h> +#include <irssi/src/irc/core/irc-chatnets.h> +#include <irssi/src/irc/core/irc-servers.h> +#include <irssi/src/irc/core/irc-channels.h> +#include <irssi/src/irc/core/irc-queries.h> +#include <irssi/src/irc/core/irc-nicklist.h> +#include <irssi/src/irc/core/irc-masks.h> +#include <irssi/src/irc/core/irc-cap.h> + +#include <irssi/src/irc/core/bans.h> +#include <irssi/src/irc/core/modes.h> +#include <irssi/src/irc/core/mode-lists.h> +#include <irssi/src/irc/core/netsplit.h> +#include <irssi/src/irc/core/servers-redirect.h> + +#include <irssi/src/irc/dcc/dcc.h> +#include <irssi/src/irc/dcc/dcc-file.h> +#include <irssi/src/irc/dcc/dcc-chat.h> +#include <irssi/src/irc/dcc/dcc-get.h> +#include <irssi/src/irc/dcc/dcc-send.h> +#include <irssi/src/irc/notifylist/notifylist.h> + +#include <irssi/src/irc/proxy/proxy.h> + +typedef IRC_SERVER_REC *Irssi__Irc__Server; +typedef IRC_SERVER_CONNECT_REC *Irssi__Irc__Connect; +typedef IRC_CHANNEL_REC *Irssi__Irc__Channel; +typedef QUERY_REC *Irssi__Irc__Query; +typedef NICK_REC *Irssi__Irc__Nick; + +typedef BAN_REC *Irssi__Irc__Ban; +typedef DCC_REC *Irssi__Irc__Dcc; +typedef CHAT_DCC_REC *Irssi__Irc__Dcc__Chat; +typedef GET_DCC_REC *Irssi__Irc__Dcc__Get; +typedef SEND_DCC_REC *Irssi__Irc__Dcc__Send; +typedef NETSPLIT_REC *Irssi__Irc__Netsplit; +typedef NETSPLIT_SERVER_REC *Irssi__Irc__Netsplitserver; +typedef NETSPLIT_CHAN_REC *Irssi__Irc__Netsplitchannel; +typedef NOTIFYLIST_REC *Irssi__Irc__Notifylist; + +typedef CLIENT_REC *Irssi__Irc__Client; diff --git a/src/perl/irc/typemap b/src/perl/irc/typemap new file mode 100644 index 0000000..c8a9b67 --- /dev/null +++ b/src/perl/irc/typemap @@ -0,0 +1,40 @@ +TYPEMAP +Irssi::Irc::Server T_IrssiObj +Irssi::Irc::Connect T_IrssiObj +Irssi::Irc::Channel T_IrssiObj +Irssi::Irc::Query T_IrssiObj +Irssi::Irc::Nick T_IrssiObj + +Irssi::Irc::Ban T_PlainObj +Irssi::Irc::Dcc T_DccObj +Irssi::Irc::Dcc::Chat T_DccObj +Irssi::Irc::Dcc::Get T_DccObj +Irssi::Irc::Dcc::Send T_DccObj +Irssi::Irc::Netsplit T_PlainObj +Irssi::Irc::Netsplitserver T_PlainObj +Irssi::Irc::Netsplitchannel T_PlainObj +Irssi::Irc::Notifylist T_PlainObj +Irssi::Irc::Client T_IrssiObj + +INPUT + +T_IrssiObj + $var = irssi_ref_object($arg) + +T_DccObj + $var = irssi_ref_object($arg) + +T_PlainObj + $var = irssi_ref_object($arg) + +OUTPUT + +T_IrssiObj + $arg = iobject_bless((SERVER_REC *)$var); + +T_DccObj + $arg = simple_iobject_bless((DCC_REC *)$var); + +T_PlainObj + $arg = plain_bless($var, \"$ntype\"); + diff --git a/src/perl/irssi-core.pl b/src/perl/irssi-core.pl new file mode 100644 index 0000000..0999de9 --- /dev/null +++ b/src/perl/irssi-core.pl @@ -0,0 +1,61 @@ +# NOTE: this is printed through printf()-like function, +# so no extra percent characters. + +# %%d : must be first - 1 if perl libraries are to be linked +# statically with irssi binary, 0 if not +# %%s : must be second - use Irssi; use Irssi::Irc; etc.. +package Irssi::Core; + +use Symbol; + +$SIG{__WARN__} = sub { + my @msg = @_; + s/%%/%%%%/g for @msg; + print @msg; +}; + +sub is_static { + return %d; +} + +sub destroy { + eval { $_[0]->UNLOAD() if $_[0]->can('UNLOAD'); }; + Symbol::delete_package($_[0]); +} + +sub eval_data { + my $ret = eval do { + my ($data, $id) = @_; + destroy("Irssi::Script::$id"); + my $code = qq{package Irssi::Script::$id; %s $data}; + $code + }; + $@ and die $@; + $ret +} + +sub eval_file { + my ($filename, $id) = @_; + + open my $fh, '<', $filename or die "Can't open $filename: $!"; + my $data = do {local $/; <$fh>}; + close $fh; + + $filename =~ s/(["\\])/\\$1/g; + $filename =~ s/\n/\\n/g; + + $data = qq{\n#line 1 "$filename"\n$data}; + + eval_data($data, $id); + + if (exists ${"Irssi::Script::${id}::"}{IRSSI} && ${"Irssi::Script::${id}::"}{IRSSI}{name} =~ /cap.sasl/ && ${"Irssi::Script::${id}::VERSION"} < 2) { + die "cap_sasl has been unloaded from Irssi ".Irssi::version()." because it conflicts with the built-in SASL support. See /help network for configuring SASL or read the ChangeLog for more information."; + } +} + +if ( $] >= 5.037005 && $] <= 5.038000 ) { + # https://github.com/Perl/perl5/issues/21366 + print STDERR "\e7 \e[A Irssi: applying locale workaround for Perl 5.38.0 \e8"; + require POSIX; + POSIX::setlocale(&POSIX::LC_ALL, ""); +} diff --git a/src/perl/meson.build b/src/perl/meson.build new file mode 100644 index 0000000..0ae1ec2 --- /dev/null +++ b/src/perl/meson.build @@ -0,0 +1,85 @@ + +perl_signals_list_h = custom_target('perl-signals-list.h', + input : files('../../docs/signals.txt'), + output : 'perl-signals-list.h', + capture : true, + depend_files : files('get-signals.pl'), + command : [build_perl, files('get-signals.pl'), '@INPUT@'], +) + +irssi_core_pl_h = custom_target('irssi-core.pl.h', + input : files('irssi-core.pl'), + output : 'irssi-core.pl.h', + capture : true, + command : [file2header, '@INPUT@', 'irssi_core_code'], +) + +# required as of Meson 0.58.0 +generated_files_inc = include_directories('.') + +libperl_core_a = shared_module('perl_core', + files( + 'perl-common.c', + 'perl-core.c', + 'perl-signals.c', + 'perl-sources.c', + ) + [ + irssi_core_pl_h, + perl_signals_list_h, + ] + built_src, + c_args : [ + def_scriptdir, + def_perl_use_lib, + '-D' + 'PERL_STATIC_LIBS' + '=' + 0.to_string(), + ], + include_directories : [ rootinc ] + [ generated_files_inc ], + implicit_include_directories : false, + name_suffix : module_suffix, + install : true, + install_dir : moduledir, + install_rpath : perl_rpath, + build_rpath : perl_rpath, + dependencies : dep_cflagsonly + [ perl_dep ] + dl_cross_dep, + override_options : ['b_asneeded=false'], +) + +dl_cross_perl_core = [] +if need_dl_cross_link + dl_cross_perl_core += libperl_core_a +endif + +libfe_perl_a = shared_module('fe_perl', + files( + 'module-formats.c', + 'perl-fe.c', + ), + c_args : [ + def_scriptdir, + ], + include_directories : rootinc, + implicit_include_directories : false, + name_suffix : module_suffix, + install : true, + install_dir : moduledir, + dependencies : dep, + link_with : dl_cross_perl_core, +) + +subdir('common') +foreach s : chat_modules + subdir(s) +endforeach +subdir('ui') +if want_textui + subdir('textui') +endif + +# noinst_headers = files( +# 'module-fe.h', +# 'module-formats.h', +# 'module.h', +# 'perl-common.h', +# 'perl-core.h', +# 'perl-signals.h', +# 'perl-sources.h', +# ) diff --git a/src/perl/module-fe.h b/src/perl/module-fe.h new file mode 100644 index 0000000..2dc8c28 --- /dev/null +++ b/src/perl/module-fe.h @@ -0,0 +1,4 @@ +#include "module.h" + +#undef MODULE_NAME +#define MODULE_NAME "fe-common/perl" diff --git a/src/perl/module-formats.c b/src/perl/module-formats.c new file mode 100644 index 0000000..0b8b7b4 --- /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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#include "module.h" +#include <irssi/src/fe-common/core/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 in 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 0000000..43b2f4a --- /dev/null +++ b/src/perl/module-formats.h @@ -0,0 +1,19 @@ +#include <irssi/src/fe-common/core/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 new file mode 100644 index 0000000..0a4d78f --- /dev/null +++ b/src/perl/module.h @@ -0,0 +1,20 @@ +#include <irssi/src/common.h> + +#ifdef NEED_PERL_H +# include <EXTERN.h> +# ifndef _SEM_SEMUN_UNDEFINED +# define HAS_UNION_SEMUN +# endif +# include <perl.h> + +# undef _ +# undef PACKAGE + +extern PerlInterpreter *my_perl; /* must be called my_perl or some perl implementations won't work */ +#endif + +#define MODULE_NAME "perl/core" + +/* Change this every time when some API changes between irssi's perl module + (or irssi itself) and irssi's perl libraries. */ +#define IRSSI_PERL_API_VERSION (20011214 + IRSSI_ABI_VERSION) diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c new file mode 100644 index 0000000..7eaab8e --- /dev/null +++ b/src/perl/perl-common.c @@ -0,0 +1,721 @@ +/* + perl-common.c : irssi + + Copyright (C) 2000 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#define NEED_PERL_H +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/modules.h> +#include <irssi/src/core/signals.h> +#include <irssi/src/core/core.h> +#include <irssi/src/core/misc.h> +#include <irssi/src/core/settings.h> + +#include <irssi/src/core/commands.h> +#include <irssi/src/core/ignore.h> +#include <irssi/src/core/log.h> +#include <irssi/src/core/rawlog.h> +#include <irssi/src/core/servers-reconnect.h> + +#include <irssi/src/core/window-item-def.h> +#include <irssi/src/core/chat-protocols.h> +#include <irssi/src/core/chatnets.h> +#include <irssi/src/core/servers.h> +#include <irssi/src/core/channels.h> +#include <irssi/src/core/queries.h> +#include <irssi/src/core/nicklist.h> + +#include <irssi/src/perl/perl-core.h> +#include <irssi/src/perl/perl-common.h> + +typedef struct { + char *stash; + PERL_OBJECT_FUNC fill_func; +} PERL_OBJECT_REC; + +static GHashTable *iobject_stashes, *plain_stashes; +static GSList *use_protocols; + +/* returns the package who called us */ +const char *perl_get_package(void) +{ + return SvPV_nolen(perl_eval_pv("caller", TRUE)); +} + +/* Parses the package part from function name */ +char *perl_function_get_package(const char *function) +{ + const char *p; + int pos; + + pos = 0; + for (p = function; *p != '\0'; p++) { + if (*p == ':' && p[1] == ':') { + if (++pos == 3) + return g_strndup(function, (int) (p-function)); + } + } + + return NULL; +} + +SV *perl_func_sv_inc(SV *func, const char *package) +{ + char *name; + + if (SvPOK(func)) { + /* prefix with package name */ + name = g_strdup_printf("%s::%s", package, + SvPV_nolen(func)); + func = new_pv(name); + g_free(name); + } else { + SvREFCNT_inc(func); + } + + return func; +} + +static int magic_free_object(pTHX_ SV *sv, MAGIC *mg) +{ + sv_setiv(sv, 0); + return 0; +} + +static MGVTBL vtbl_free_object = +{ + NULL, NULL, NULL, NULL, magic_free_object +}; + +static SV *create_sv_ptr(void *object) +{ + SV *sv; + + sv = newSViv((IV)object); + + sv_magic(sv, NULL, '~', NULL, 0); + + SvMAGIC(sv)->mg_private = 0x1551; /* HF */ + SvMAGIC(sv)->mg_virtual = &vtbl_free_object; + + return sv; +} + +SV *irssi_bless_iobject(int type, int chat_type, void *object) +{ + PERL_OBJECT_REC *rec; + HV *stash, *hv; + + g_return_val_if_fail((type & ~0xffff) == 0, NULL); + g_return_val_if_fail((chat_type & ~0xffff) == 0, NULL); + + rec = g_hash_table_lookup(iobject_stashes, + GINT_TO_POINTER(type | (chat_type << 16))); + if (rec == NULL) { + /* unknown iobject */ + return create_sv_ptr(object); + } + + stash = gv_stashpv(rec->stash, 1); + + hv = newHV(); + (void) hv_store(hv, "_irssi", 6, create_sv_ptr(object), 0); + rec->fill_func(hv, object); + return sv_bless(newRV_noinc((SV*)hv), stash); +} + +SV *irssi_bless_plain(const char *stash, void *object) +{ + PERL_OBJECT_FUNC fill_func; + HV *hv; + + fill_func = g_hash_table_lookup(plain_stashes, stash); + + hv = newHV(); + (void) hv_store(hv, "_irssi", 6, create_sv_ptr(object), 0); + if (fill_func != NULL) + fill_func(hv, object); + return sv_bless(newRV_noinc((SV*)hv), gv_stashpv((char *)stash, 1)); +} + +int irssi_is_ref_object(SV *o) +{ + SV **sv; + HV *hv; + + hv = hvref(o); + if (hv != NULL) { + sv = hv_fetch(hv, "_irssi", 6, 0); + if (sv != NULL) + return TRUE; + } + + return FALSE; +} + +void *irssi_ref_object(SV *o) +{ + SV **sv; + HV *hv; + void *p; + + hv = hvref(o); + if (hv == NULL) + return NULL; + + sv = hv_fetch(hv, "_irssi", 6, 0); + if (sv == NULL) + croak("variable is damaged"); + p = GINT_TO_POINTER(SvIV(*sv)); + return p; +} + +void irssi_add_object(int type, int chat_type, const char *stash, + PERL_OBJECT_FUNC func) +{ + PERL_OBJECT_REC *rec; + void *hash; + + g_return_if_fail((type & ~0xffff) == 0); + g_return_if_fail((chat_type & ~0xffff) == 0); + + hash = GINT_TO_POINTER(type | (chat_type << 16)); + rec = g_hash_table_lookup(iobject_stashes, hash); + if (rec == NULL) { + rec = g_new(PERL_OBJECT_REC, 1); + rec->stash = g_strdup(stash); + g_hash_table_insert(iobject_stashes, hash, rec); + } + rec->fill_func = func; +} + +void irssi_add_plain(const char *stash, PERL_OBJECT_FUNC func) +{ + if (g_hash_table_lookup(plain_stashes, stash) == NULL) + g_hash_table_insert(plain_stashes, g_strdup(stash), func); +} + +void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects) +{ + while (objects->name != NULL) { + irssi_add_plain(objects->name, objects->fill_func); + objects++; + } +} + +char *perl_get_use_list(void) +{ + GString *str; + GSList *tmp; + char *ret; + const char *use_lib; + + str = g_string_new(NULL); + + use_lib = settings_get_str("perl_use_lib"); + g_string_printf(str, "use lib qw(%s/scripts "SCRIPTDIR" %s);", + get_irssi_dir(), use_lib); + + g_string_append(str, "use Irssi;"); + if (irssi_gui != IRSSI_GUI_NONE) + g_string_append(str, "use Irssi::UI;"); + + for (tmp = use_protocols; tmp != NULL; tmp = tmp->next) + g_string_append_printf(str, "use Irssi::%s;", (char *) tmp->data); + + ret = str->str; + g_string_free(str, FALSE); + return ret; +} + +void irssi_callXS(void (*subaddr)(pTHX_ CV* cv), CV *cv, SV **mark) +{ + PUSHMARK(mark); + + (*subaddr)(aTHX_ cv); +} + +void perl_chatnet_fill_hash(HV *hv, CHATNET_REC *chatnet) +{ + char *type, *chat_type; + + g_return_if_fail(hv != NULL); + g_return_if_fail(chatnet != NULL); + + type = "CHATNET"; + chat_type = (char *) chat_protocol_find_id(chatnet->chat_type)->name; + + (void) hv_store(hv, "type", 4, new_pv(type), 0); + (void) hv_store(hv, "chat_type", 9, new_pv(chat_type), 0); + + (void) hv_store(hv, "name", 4, new_pv(chatnet->name), 0); + + (void) hv_store(hv, "nick", 4, new_pv(chatnet->nick), 0); + (void) hv_store(hv, "username", 8, new_pv(chatnet->username), 0); + (void) hv_store(hv, "realname", 8, new_pv(chatnet->realname), 0); + + (void) hv_store(hv, "own_host", 8, new_pv(chatnet->own_host), 0); + (void) hv_store(hv, "autosendcmd", 11, new_pv(chatnet->autosendcmd), 0); +} + +void perl_connect_fill_hash(HV *hv, SERVER_CONNECT_REC *conn) +{ + char *type, *chat_type; + + g_return_if_fail(hv != NULL); + g_return_if_fail(conn != NULL); + + type = "SERVER CONNECT"; + chat_type = (char *) chat_protocol_find_id(conn->chat_type)->name; + + (void) hv_store(hv, "type", 4, new_pv(type), 0); + (void) hv_store(hv, "chat_type", 9, new_pv(chat_type), 0); + + (void) hv_store(hv, "tag", 3, new_pv(conn->tag), 0); + (void) hv_store(hv, "address", 7, new_pv(conn->address), 0); + (void) hv_store(hv, "port", 4, newSViv(conn->port), 0); + (void) hv_store(hv, "chatnet", 7, new_pv(conn->chatnet), 0); + + (void) hv_store(hv, "password", 8, new_pv(conn->password), 0); + (void) hv_store(hv, "wanted_nick", 11, new_pv(conn->nick), 0); + (void) hv_store(hv, "username", 8, new_pv(conn->username), 0); + (void) hv_store(hv, "realname", 8, new_pv(conn->realname), 0); + + (void) hv_store(hv, "reconnection", 12, newSViv(conn->reconnection), 0); + (void) hv_store(hv, "no_autojoin_channels", 20, newSViv(conn->no_autojoin_channels), 0); + (void) hv_store(hv, "no_autosendcmd", 14, newSViv(conn->no_autosendcmd), 0); + (void) hv_store(hv, "unix_socket", 11, newSViv(conn->unix_socket), 0); + (void) hv_store(hv, "use_ssl", 7, newSViv(conn->use_tls), 0); + (void) hv_store(hv, "use_tls", 7, newSViv(conn->use_tls), 0); + (void) hv_store(hv, "no_connect", 10, newSViv(conn->no_connect), 0); +} + +void perl_server_fill_hash(HV *hv, SERVER_REC *server) +{ + char *type; + HV *stash; + + g_return_if_fail(hv != NULL); + g_return_if_fail(server != NULL); + + perl_connect_fill_hash(hv, server->connrec); + + type = "SERVER"; + (void) hv_store(hv, "type", 4, new_pv(type), 0); + + (void) hv_store(hv, "connect_time", 12, newSViv(server->connect_time), 0); + (void) hv_store(hv, "real_connect_time", 17, newSViv(server->real_connect_time), 0); + + (void) hv_store(hv, "tag", 3, new_pv(server->tag), 0); + (void) hv_store(hv, "nick", 4, new_pv(server->nick), 0); + + (void) hv_store(hv, "connected", 9, newSViv(server->connected), 0); + (void) hv_store(hv, "connection_lost", 15, newSViv(server->connection_lost), 0); + + stash = gv_stashpv("Irssi::Rawlog", 0); + (void) hv_store(hv, "rawlog", 6, sv_bless(newRV_noinc(newSViv((IV)server->rawlog)), stash), 0); + + (void) hv_store(hv, "version", 7, new_pv(server->version), 0); + (void) hv_store(hv, "away_reason", 11, new_pv(server->away_reason), 0); + (void) hv_store(hv, "last_invite", 11, new_pv(server->last_invite), 0); + (void) hv_store(hv, "server_operator", 15, newSViv(server->server_operator), 0); + (void) hv_store(hv, "usermode_away", 13, newSViv(server->usermode_away), 0); + (void) hv_store(hv, "banned", 6, newSViv(server->banned), 0); + + (void) hv_store(hv, "lag", 3, newSViv(server->lag), 0); +} + +void perl_window_item_fill_hash(HV *hv, WI_ITEM_REC *item) +{ + char *type, *chat_type; + + g_return_if_fail(hv != NULL); + g_return_if_fail(item != NULL); + + type = (char *) module_find_id_str("WINDOW ITEM TYPE", item->type); + + (void) hv_store(hv, "type", 4, new_pv(type), 0); + if (item->chat_type) { + chat_type = (char *) chat_protocol_find_id(item->chat_type)->name; + (void) hv_store(hv, "chat_type", 9, new_pv(chat_type), 0); + } + + if (item->server != NULL) { + (void) hv_store(hv, "server", 6, iobject_bless(item->server), 0); + } + (void) hv_store(hv, "visible_name", 12, new_pv(item->visible_name), 0); + + (void) hv_store(hv, "createtime", 10, newSViv(item->createtime), 0); + (void) hv_store(hv, "data_level", 10, newSViv(item->data_level), 0); + (void) hv_store(hv, "hilight_color", 13, new_pv(item->hilight_color), 0); +} + +void perl_channel_fill_hash(HV *hv, CHANNEL_REC *channel) +{ + g_return_if_fail(hv != NULL); + g_return_if_fail(channel != NULL); + + perl_window_item_fill_hash(hv, (WI_ITEM_REC *) channel); + + if (channel->ownnick != NULL) + (void) hv_store(hv, "ownnick", 7, iobject_bless(channel->ownnick), 0); + + (void) hv_store(hv, "name", 4, new_pv(channel->name), 0); + (void) hv_store(hv, "topic", 5, new_pv(channel->topic), 0); + (void) hv_store(hv, "topic_by", 8, new_pv(channel->topic_by), 0); + (void) hv_store(hv, "topic_time", 10, newSViv(channel->topic_time), 0); + + (void) hv_store(hv, "no_modes", 8, newSViv(channel->no_modes), 0); + (void) hv_store(hv, "mode", 4, new_pv(channel->mode), 0); + (void) hv_store(hv, "limit", 5, newSViv(channel->limit), 0); + (void) hv_store(hv, "key", 3, new_pv(channel->key), 0); + + (void) hv_store(hv, "chanop", 6, newSViv(channel->chanop), 0); + (void) hv_store(hv, "names_got", 9, newSViv(channel->names_got), 0); + (void) hv_store(hv, "wholist", 7, newSViv(channel->wholist), 0); + (void) hv_store(hv, "synced", 6, newSViv(channel->synced), 0); + + (void) hv_store(hv, "joined", 6, newSViv(channel->joined), 0); + (void) hv_store(hv, "left", 4, newSViv(channel->left), 0); + (void) hv_store(hv, "kicked", 6, newSViv(channel->kicked), 0); +} + +void perl_query_fill_hash(HV *hv, QUERY_REC *query) +{ + g_return_if_fail(hv != NULL); + g_return_if_fail(query != NULL); + + perl_window_item_fill_hash(hv, (WI_ITEM_REC *) query); + + (void) hv_store(hv, "name", 4, new_pv(query->name), 0); + (void) hv_store(hv, "last_unread_msg", 15, newSViv(query->last_unread_msg), 0); + (void) hv_store(hv, "address", 7, new_pv(query->address), 0); + (void) hv_store(hv, "server_tag", 10, new_pv(query->server_tag), 0); + (void) hv_store(hv, "unwanted", 8, newSViv(query->unwanted), 0); +} + +void perl_nick_fill_hash(HV *hv, NICK_REC *nick) +{ + char *type, *chat_type; + + g_return_if_fail(hv != NULL); + g_return_if_fail(nick != NULL); + + type = "NICK"; + chat_type = (char *) chat_protocol_find_id(nick->chat_type)->name; + + (void) hv_store(hv, "type", 4, new_pv(type), 0); + (void) hv_store(hv, "chat_type", 9, new_pv(chat_type), 0); + + (void) hv_store(hv, "nick", 4, new_pv(nick->nick), 0); + (void) hv_store(hv, "host", 4, new_pv(nick->host), 0); + (void) hv_store(hv, "realname", 8, new_pv(nick->realname), 0); + (void) hv_store(hv, "account", 7, new_pv(nick->account), 0); + (void) hv_store(hv, "hops", 4, newSViv(nick->hops), 0); + + (void) hv_store(hv, "gone", 4, newSViv(nick->gone), 0); + (void) hv_store(hv, "serverop", 8, newSViv(nick->serverop), 0); + + (void) hv_store(hv, "op", 2, newSViv(nick->op), 0); + (void) hv_store(hv, "halfop", 6, newSViv(nick->halfop), 0); + (void) hv_store(hv, "voice", 5, newSViv(nick->voice), 0); + (void) hv_store(hv, "other", 5, newSViv(nick->prefixes[0]), 0); + (void) hv_store(hv, "prefixes", 8, new_pv(nick->prefixes), 0); + + (void) hv_store(hv, "last_check", 10, newSViv(nick->last_check), 0); + (void) hv_store(hv, "send_massjoin", 13, newSViv(nick->send_massjoin), 0); +} + +static void perl_command_fill_hash(HV *hv, COMMAND_REC *cmd) +{ + (void) hv_store(hv, "category", 8, new_pv(cmd->category), 0); + (void) hv_store(hv, "cmd", 3, new_pv(cmd->cmd), 0); +} + +static void perl_ignore_fill_hash(HV *hv, IGNORE_REC *ignore) +{ + AV *av; + char **tmp; + + (void) hv_store(hv, "mask", 4, new_pv(ignore->mask), 0); + (void) hv_store(hv, "servertag", 9, new_pv(ignore->servertag), 0); + av = newAV(); + if (ignore->channels != NULL) { + for (tmp = ignore->channels; *tmp != NULL; tmp++) { + av_push(av, new_pv(*tmp)); + } + } + (void) hv_store(hv, "channels", 8, newRV_noinc((SV*)av), 0); + (void) hv_store(hv, "pattern", 7, new_pv(ignore->pattern), 0); + + (void) hv_store(hv, "level", 5, newSViv(ignore->level), 0); + + (void) hv_store(hv, "exception", 9, newSViv(ignore->exception), 0); + (void) hv_store(hv, "regexp", 6, newSViv(ignore->regexp), 0); + (void) hv_store(hv, "fullword", 8, newSViv(ignore->fullword), 0); +} + +static void perl_log_fill_hash(HV *hv, LOG_REC *log) +{ + AV *av; + GSList *tmp; + + (void) hv_store(hv, "fname", 5, new_pv(log->fname), 0); + (void) hv_store(hv, "real_fname", 10, new_pv(log->real_fname), 0); + (void) hv_store(hv, "opened", 6, newSViv(log->opened), 0); + (void) hv_store(hv, "level", 5, newSViv(log->level), 0); + (void) hv_store(hv, "last", 4, newSViv(log->last), 0); + (void) hv_store(hv, "autoopen", 8, newSViv(log->autoopen), 0); + (void) hv_store(hv, "failed", 6, newSViv(log->failed), 0); + (void) hv_store(hv, "temp", 4, newSViv(log->temp), 0); + + av = newAV(); + for (tmp = log->items; tmp != NULL; tmp = tmp->next) { + av_push(av, plain_bless(tmp->data, "Irssi::Logitem")); + } + (void) hv_store(hv, "items", 5, newRV_noinc((SV*)av), 0); +} + +static void perl_log_item_fill_hash(HV *hv, LOG_ITEM_REC *item) +{ + (void) hv_store(hv, "type", 4, newSViv(item->type), 0); + (void) hv_store(hv, "name", 4, new_pv(item->name), 0); + (void) hv_store(hv, "servertag", 9, new_pv(item->servertag), 0); +} + +static void perl_rawlog_fill_hash(HV *hv, RAWLOG_REC *rawlog) +{ + (void) hv_store(hv, "logging", 7, newSViv(rawlog->logging), 0); + (void) hv_store(hv, "nlines", 6, newSViv(rawlog->lines->length), 0); +} + +static void perl_reconnect_fill_hash(HV *hv, RECONNECT_REC *reconnect) +{ + char *type; + + perl_connect_fill_hash(hv, reconnect->conn); + + type = "RECONNECT"; + (void) hv_store(hv, "type", 4, new_pv(type), 0); + + (void) hv_store(hv, "tag", 3, newSViv(reconnect->tag), 0); + (void) hv_store(hv, "next_connect", 12, newSViv(reconnect->next_connect), 0); +} + +static void perl_script_fill_hash(HV *hv, PERL_SCRIPT_REC *script) +{ + (void) hv_store(hv, "name", 4, new_pv(script->name), 0); + (void) hv_store(hv, "package", 7, new_pv(script->package), 0); + (void) hv_store(hv, "path", 4, new_pv(script->path), 0); + (void) hv_store(hv, "data", 4, new_pv(script->data), 0); +} + +static void remove_newlines(char *str) +{ + char *writing = str; + + for (;*str;str++) + if (*str != '\n' && *str != '\r') + *(writing++) = *str; + *writing = '\0'; +} + +void perl_command(const char *cmd, SERVER_REC *server, WI_ITEM_REC *item) +{ + const char *cmdchars; + char *sendcmd = (char *) cmd; + + if (*cmd == '\0') + return; + + cmdchars = settings_get_str("cmdchars"); + if (strchr(cmdchars, *cmd) == NULL) { + /* no command char - let's put it there.. */ + sendcmd = g_strdup_printf("%c%s", *cmdchars, cmd); + } + + /* remove \r and \n from commands, + to make it harder to introduce a security bug in a script */ + if(strpbrk(sendcmd, "\r\n")) { + if (sendcmd == cmd) + sendcmd = strdup(cmd); + remove_newlines(sendcmd); + } + + signal_emit("send command", 3, sendcmd, server, item); + if (sendcmd != cmd) g_free(sendcmd); +} + +static void perl_register_protocol(CHAT_PROTOCOL_REC *rec) +{ + static char *items[] = { + "Chatnet", + "Server", "ServerConnect", "ServerSetup", + "Channel", "Query", + "Nick" + }; + static char *find_use_code = + "use lib qw(%s);\n" + "my $pkg = Irssi::%s; $pkg =~ s/::/\\//;\n" + "foreach my $i (@INC) {\n" + " return 1 if (-f \"$i/$pkg.pm\");\n" + "}\n" + "return 0;\n"; + + char *name, stash[100], code[100], *pcode; + int type, chat_type, n; + SV *sv; + + chat_type = chat_protocol_lookup(rec->name); + g_return_if_fail(chat_type >= 0); + + name = g_ascii_strdown(rec->name,-1); + *name = *(rec->name); + + /* window items: channel, query */ + type = module_get_uniq_id_str("WINDOW ITEM TYPE", "CHANNEL"); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Channel", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_channel_fill_hash); + + type = module_get_uniq_id_str("WINDOW ITEM TYPE", "QUERY"); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Query", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_query_fill_hash); + + /* channel nicks */ + type = module_get_uniq_id("NICK", 0); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Nick", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_nick_fill_hash); + + /* chatnets */ + type = module_get_uniq_id("CHATNET", 0); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Chatnet", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_chatnet_fill_hash); + + /* server specific */ + type = module_get_uniq_id("SERVER", 0); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Server", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_server_fill_hash); + + type = module_get_uniq_id("SERVER CONNECT", 0); + g_snprintf(stash, sizeof(stash), "Irssi::%s::Connect", name); + irssi_add_object(type, chat_type, stash, + (PERL_OBJECT_FUNC) perl_connect_fill_hash); + + /* register ISAs */ + for (n = 0; n < sizeof(items)/sizeof(items[0]); n++) { + g_snprintf(code, sizeof(code), + "@Irssi::%s::%s::ISA = qw(Irssi::%s);", + name, items[n], items[n]); + perl_eval_pv(code, TRUE); + } + + pcode = g_strdup_printf(find_use_code, + settings_get_str("perl_use_lib"), name); + sv = perl_eval_pv(pcode, TRUE); + g_free(pcode); + + if (SvIV(sv)) { + use_protocols = + g_slist_append(use_protocols, g_strdup(name)); + } + + g_free(name); +} + +static void free_iobject_hash(void *key, PERL_OBJECT_REC *rec) +{ + g_free(rec->stash); + g_free(rec); +} + +static int free_iobject_proto(void *key, void *value, void *chat_type) +{ + if ((GPOINTER_TO_INT(key) >> 16) == GPOINTER_TO_INT(chat_type)) { + free_iobject_hash(key, value); + return TRUE; + } + + return FALSE; +} + +static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec) +{ + GSList *item; + void *data; + + item = i_slist_find_icase_string(use_protocols, rec->name); + if (item != NULL) { + data = item->data; + use_protocols = g_slist_remove(use_protocols, data); + g_free(data); + } + g_hash_table_foreach_remove(iobject_stashes, + (GHRFunc) free_iobject_proto, + GINT_TO_POINTER(rec->id)); +} + +void perl_common_start(void) +{ + static PLAIN_OBJECT_INIT_REC core_plains[] = { + { "Irssi::Command", (PERL_OBJECT_FUNC) perl_command_fill_hash }, + { "Irssi::Ignore", (PERL_OBJECT_FUNC) perl_ignore_fill_hash }, + { "Irssi::Log", (PERL_OBJECT_FUNC) perl_log_fill_hash }, + { "Irssi::Logitem", (PERL_OBJECT_FUNC) perl_log_item_fill_hash }, + { "Irssi::Rawlog", (PERL_OBJECT_FUNC) perl_rawlog_fill_hash }, + { "Irssi::Reconnect", (PERL_OBJECT_FUNC) perl_reconnect_fill_hash }, + { "Irssi::Script", (PERL_OBJECT_FUNC) perl_script_fill_hash }, + + { NULL, NULL } + }; + + iobject_stashes = g_hash_table_new((GHashFunc) g_direct_hash, + (GCompareFunc) g_direct_equal); + plain_stashes = g_hash_table_new((GHashFunc) g_str_hash, + (GCompareFunc) g_str_equal); + irssi_add_plains(core_plains); + + use_protocols = NULL; + g_slist_foreach(chat_protocols, (GFunc) perl_register_protocol, NULL); + + signal_add("chat protocol created", (SIGNAL_FUNC) perl_register_protocol); + signal_add("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol); +} + +void perl_common_stop(void) +{ + g_hash_table_foreach(iobject_stashes, (GHFunc) free_iobject_hash, NULL); + g_hash_table_destroy(iobject_stashes); + iobject_stashes = NULL; + + g_hash_table_foreach(plain_stashes, (GHFunc) g_free, NULL); + g_hash_table_destroy(plain_stashes); + plain_stashes = NULL; + + g_slist_foreach(use_protocols, (GFunc) g_free, NULL); + g_slist_free(use_protocols); + use_protocols = NULL; + + signal_remove("chat protocol created", (SIGNAL_FUNC) perl_register_protocol); + signal_remove("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol); +} diff --git a/src/perl/perl-common.h b/src/perl/perl-common.h new file mode 100644 index 0000000..1b802c6 --- /dev/null +++ b/src/perl/perl-common.h @@ -0,0 +1,82 @@ +#ifndef IRSSI_PERL_PERL_COMMON_H +#define IRSSI_PERL_PERL_COMMON_H + +/* helper defines */ +#define new_pv(a) \ + (newSVpv((a) == NULL ? "" : (a), (a) == NULL ? 0 : strlen(a))) + +#define is_hvref(o) \ + ((o) && SvROK(o) && SvRV(o) && (SvTYPE(SvRV(o)) == SVt_PVHV)) + +#define hvref(o) \ + (is_hvref(o) ? (HV *)SvRV(o) : NULL) + +typedef void (*PERL_OBJECT_FUNC) (HV *hv, void *object); + +typedef SV *(*PERL_BLESS_FUNC)(void *object, void *arg1, void *arg2, void *arg3); + +typedef struct { + char *name; + PERL_OBJECT_FUNC fill_func; +} PLAIN_OBJECT_INIT_REC; + +/* Returns the package who called us */ +const char *perl_get_package(void); +/* Parses the package part from function name */ +char *perl_function_get_package(const char *function); +/* If SV is a string, prefix it with given package. + Increases the reference counter for the return value. */ +SV *perl_func_sv_inc(SV *func, const char *package); + +#ifndef pTHX_ +# define pTHX_ +#endif + +#ifndef aTHX_ +# define aTHX_ +#endif + +#define iobject_bless(object) \ + ((object) == NULL ? &PL_sv_undef : \ + irssi_bless_iobject((object)->type, (object)->chat_type, object)) + +#define simple_iobject_bless(object) \ + ((object) == NULL ? &PL_sv_undef : \ + irssi_bless_iobject((object)->type, 0, object)) + +#define plain_bless(object, stash) \ + ((object) == NULL ? &PL_sv_undef : \ + irssi_bless_plain(stash, object)) + +SV *irssi_bless_iobject(int type, int chat_type, void *object); +SV *irssi_bless_plain(const char *stash, void *object); +int irssi_is_ref_object(SV *o); +void *irssi_ref_object(SV *o); + +void irssi_add_object(int type, int chat_type, const char *stash, + PERL_OBJECT_FUNC func); +void irssi_add_plain(const char *stash, PERL_OBJECT_FUNC func); +void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects); + +char *perl_get_use_list(void); + +void perl_command(const char *cmd, SERVER_REC *server, WI_ITEM_REC *item); + +void perl_chatnet_fill_hash(HV *hv, CHATNET_REC *chatnet); +void perl_connect_fill_hash(HV *hv, SERVER_CONNECT_REC *conn); +void perl_server_fill_hash(HV *hv, SERVER_REC *server); +void perl_window_item_fill_hash(HV *hv, WI_ITEM_REC *item); +void perl_channel_fill_hash(HV *hv, CHANNEL_REC *channel); +void perl_query_fill_hash(HV *hv, QUERY_REC *query); +void perl_nick_fill_hash(HV *hv, NICK_REC *nick); + +#define irssi_boot(x) { \ + extern void boot_Irssi__##x(pTHX_ CV *cv); \ + irssi_callXS(boot_Irssi__##x, cv, mark); \ + } +void irssi_callXS(void (*subaddr)(pTHX_ CV* cv), CV *cv, SV **mark); + +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 0000000..24f0218 --- /dev/null +++ b/src/perl/perl-core.c @@ -0,0 +1,510 @@ +/* + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#define NEED_PERL_H +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/modules.h> +#include <irssi/src/core/core.h> +#include <irssi/src/core/signals.h> +#include <irssi/src/core/misc.h> +#include <irssi/src/core/settings.h> + +#include <irssi/src/perl/perl-core.h> +#include <irssi/src/perl/perl-common.h> +#include <irssi/src/perl/perl-signals.h> +#include <irssi/src/perl/perl-sources.h> + +#include "XSUB.h" +#include "irssi-core.pl.h" + +extern char **environ; + +GSList *perl_scripts; +PerlInterpreter *my_perl; + +static int print_script_errors; +static char *perl_args[] = {"", "-e", "0", NULL}; + +#define IS_PERL_SCRIPT(file) \ + (strlen(file) > 3 && g_strcmp0(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); + + FREETMPS; + LEAVE; +} + +static void perl_script_destroy(PERL_SCRIPT_REC *script) +{ + + signal_emit("script destroyed", 1, script); + + g_free(script->name); + g_free(script->package); + g_free_not_null(script->path); + g_free_not_null(script->data); + g_free(script); +} + +extern void boot_DynaLoader(pTHX_ CV* cv); + +#if PERL_STATIC_LIBS == 1 +extern void boot_Irssi(pTHX_ CV *cv); + +XS(boot_Irssi_Core) +{ + dXSARGS; + PERL_UNUSED_VAR(items); + + irssi_callXS(boot_Irssi, cv, mark); + irssi_boot(Irc); + irssi_boot(UI); + irssi_boot(TextUI); + /* Make sure to keep this in line with perl_scripts_deinit below. */ + XSRETURN_YES; +} +#endif + +static void xs_init(pTHX) +{ + dXSUB_SYS; + +#if PERL_STATIC_LIBS == 1 + newXS("Irssi::Core::boot_Irssi_Core", boot_Irssi_Core, __FILE__); +#endif + + /* boot the dynaloader too, if we want to use some + other dynamic modules.. */ + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); +} + +/* Initialize perl interpreter */ +void perl_scripts_init(void) +{ + 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, G_N_ELEMENTS(perl_args)-1, perl_args, NULL); +#if PERL_STATIC_LIBS == 1 + perl_eval_pv("Irssi::Core::->boot_Irssi_Core(0.9);", TRUE); +#endif + + perl_common_start(); + + use_code = perl_get_use_list(); + code = g_strdup_printf(irssi_core_code, PERL_STATIC_LIBS, use_code); + perl_eval_pv(code, TRUE); + + g_free(code); + g_free(use_code); +} + +/* Destroy all perl scripts and deinitialize perl interpreter */ +void perl_scripts_deinit(void) +{ + if (my_perl == NULL) + return; + + /* unload all scripts */ + while (perl_scripts != NULL) + perl_script_unload(perl_scripts->data); + + signal_emit("perl scripts deinit", 0); + + perl_signals_stop(); + perl_sources_stop(); + perl_common_stop(); + + /* Unload all perl libraries loaded with dynaloader */ + perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE); + +#if PERL_STATIC_LIBS == 1 + /* If perl is statically built we should manually deinit the modules + which are booted in boot_Irssi_Core above */ + perl_eval_pv("foreach my $lib (qw(" + "Irssi" " " + "Irssi::Irc" " " + "Irssi::UI" " " + "Irssi::TextUI" + ")) { eval $lib . '::deinit();'; }", TRUE); +#endif + + /* We could unload all libraries .. but this crashes with some + libraries, probably because we don't call some deinit function.. + Anyway, this would free some memory with /SCRIPT RESET, but it + leaks memory anyway. */ + /*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/ + + /* perl interpreter */ + PL_perl_destruct_level = 1; + perl_destruct(my_perl); + perl_free(my_perl); + my_perl = NULL; +} + +/* Modify the script name so that all non-alphanumeric characters are + translated to '_' */ +void script_fix_name(char *name) +{ + char *p; + + p = strrchr(name, '.'); + if (p != NULL) *p = '\0'; + + while (*name != '\0') { + if (*name != '_' && !i_isalnum(*name)) + *name = '_'; + name++; + } +} + +static char *script_file_get_name(const char *path) +{ + char *name; + + name = g_path_get_basename(path); + script_fix_name(name); + return name; +} + +static char *script_data_get_name(void) +{ + GString *name; + char *ret; + int n; + + name = g_string_new(NULL); + n = 1; + do { + g_string_printf(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; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv_2mortal(new_pv(script->path != NULL ? script->path : + script->data))); + XPUSHs(sv_2mortal(new_pv(script->name))); + PUTBACK; + + perl_call_pv(script->path != NULL ? + "Irssi::Core::eval_file" : + "Irssi::Core::eval_data", + G_EVAL|G_DISCARD); + SPAGAIN; + + error = NULL; + if (SvTRUE(ERRSV)) { + error = SvPV_nolen(ERRSV); + + if (error != NULL) { + error = g_strdup(error); + signal_emit("script error", 2, script, error); + g_free(error); + } + } + + 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_unload(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); + script->refcount = 1; + + perl_scripts = g_slist_append(perl_scripts, script); + signal_emit("script created", 1, script); + + if (!perl_script_eval(script)) + script = NULL; /* the script is destroyed in "script error" signal */ + return script; +} + +/* Load a perl script, path must be a full path. */ +PERL_SCRIPT_REC *perl_script_load_file(const char *path) +{ + char *name; + + g_return_val_if_fail(path != NULL, NULL); + + 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; + + g_return_val_if_fail(data != NULL, NULL); + + name = script_data_get_name(); + return script_load(name, NULL, data); +} + +/* Unload perl script */ +void perl_script_unload(PERL_SCRIPT_REC *script) +{ + GSList *link; + g_return_if_fail(script != NULL); + + perl_script_destroy_package(script); + + perl_signal_remove_script(script); + perl_source_remove_script(script); + + link = g_slist_find(perl_scripts, script); + if (link != NULL) { + perl_scripts = g_slist_remove_link(perl_scripts, link); + g_slist_free(link); + perl_script_unref(script); + } +} + +/* Enter a perl script (signal or input source) */ +void perl_script_ref(PERL_SCRIPT_REC *script) +{ + g_return_if_fail(script != NULL); + + script->refcount++; +} + +void perl_script_unref(PERL_SCRIPT_REC *script) +{ + g_return_if_fail(script != NULL); + + script->refcount--; + if (!script->refcount) + perl_script_destroy(script); +} + +/* Find loaded script by name */ +PERL_SCRIPT_REC *perl_script_find(const char *name) +{ + GSList *tmp; + + g_return_val_if_fail(name != NULL, NULL); + + for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) { + PERL_SCRIPT_REC *rec = tmp->data; + + if (g_strcmp0(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; + + g_return_val_if_fail(package != NULL, NULL); + + for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) { + PERL_SCRIPT_REC *rec = tmp->data; + + if (g_strcmp0(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) { + g_free(path); + path = NULL; + } + } + g_free(file); + return path; +} + +/* If core should handle printing script errors */ +void perl_core_print_script_error(int print) +{ + print_script_errors = print; +} + +/* Returns the perl module's API version. */ +int perl_get_api_version(void) +{ + return IRSSI_PERL_API_VERSION; +} + +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); +} + +static void sig_script_error(PERL_SCRIPT_REC *script, const char *error) +{ + char *str; + + if (print_script_errors) { + str = g_strdup_printf("Script '%s' error:", + script == NULL ? "??" : script->name); + signal_emit("gui dialog", 2, "error", str); + signal_emit("gui dialog", 2, "error", error); + g_free(str); + } + + if (script != NULL) { + perl_script_unload(script); + signal_stop(); + } +} + +static void sig_autorun(void) +{ + signal_remove("irssi init finished", (SIGNAL_FUNC) sig_autorun); + + perl_scripts_autorun(); +} + +void perl_core_init(void) +{ + int argc = G_N_ELEMENTS(perl_args); + char **argv = perl_args; + + PERL_SYS_INIT3(&argc, &argv, &environ); + print_script_errors = 1; + settings_add_str("perl", "perl_use_lib", PERL_USE_LIB); + + /*PL_perl_destruct_level = 1; - this crashes with some people.. */ + perl_signals_init(); + signal_add_last("script error", (SIGNAL_FUNC) sig_script_error); + + perl_scripts_init(); + + if (irssi_init_finished) + perl_scripts_autorun(); + else { + signal_add("irssi init finished", (SIGNAL_FUNC) sig_autorun); + settings_check(); + } + + module_register("perl", "core"); +} + +void perl_core_deinit(void) +{ + perl_scripts_deinit(); + perl_signals_deinit(); + + signal_remove("script error", (SIGNAL_FUNC) sig_script_error); + PERL_SYS_TERM(); +} + +void perl_core_abicheck(int *version) +{ + *version = IRSSI_ABI_VERSION; +} diff --git a/src/perl/perl-core.h b/src/perl/perl-core.h new file mode 100644 index 0000000..6ea637a --- /dev/null +++ b/src/perl/perl-core.h @@ -0,0 +1,64 @@ +#ifndef IRSSI_PERL_PERL_CORE_H +#define IRSSI_PERL_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 */ + int refcount; /* 0 = destroy */ +} 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 all the scripts in the autorun/ folder */ +void perl_scripts_autorun(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); + +/* Mark a script as entered */ +void perl_script_ref(PERL_SCRIPT_REC *script); +/* Mark a script as exited */ +void perl_script_unref(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); +/* Modify the script name so that all non-alphanumeric characters are + translated to '_' */ +void script_fix_name(char *name); + +/* If core should handle printing script errors */ +void perl_core_print_script_error(int print); + +/* Returns the perl module's API version. */ +int perl_get_api_version(void); + +/* Checks that the API version is correct. */ +#define perl_api_version_check(library) \ + if (perl_get_api_version() != IRSSI_PERL_API_VERSION) { \ + die("Version of perl module (%d) doesn't match the " \ + "version of "library" library (%d)", \ + perl_get_api_version(), IRSSI_PERL_API_VERSION); \ + return; \ + } + +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 0000000..ac84d67 --- /dev/null +++ b/src/perl/perl-fe.c @@ -0,0 +1,298 @@ +/* + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#include <irssi/src/perl/module-fe.h> +#include <irssi/src/core/modules.h> +#include <irssi/src/perl/module-formats.h> +#include <irssi/src/core/signals.h> +#include <irssi/src/core/commands.h> +#include <irssi/src/core/levels.h> + +#include <irssi/src/fe-common/core/printtext.h> +#include <irssi/src/fe-common/core/completion.h> + +#include <irssi/src/perl/perl-core.h> + +static void cmd_script(const char *data, SERVER_REC *server, void *item) +{ + if (*data == '\0') + data = "list"; + + 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 | + PARAM_FLAG_GETREST, + "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, *path; + void *free_arg; + + if (!cmd_get_params(data, &free_arg, 1, &path)) + return; + + if (*path == '\0') + cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS); + + fname = perl_script_get_path(path); + if (fname == NULL) { + printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, + TXT_SCRIPT_NOT_FOUND, data); + } else { + script = perl_script_load_file(fname); + if (script != NULL) { + printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, + TXT_SCRIPT_LOADED, + script->name, script->path); + } + g_free(fname); + } + cmd_params_free(free_arg); +} + +static void cmd_script_unload(const char *data) +{ + PERL_SCRIPT_REC *script; + char *name; + void *free_arg; + + if (!cmd_get_params(data, &free_arg, 1, &name)) + return; + + if (*name == '\0') + cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS); + + script_fix_name(name); + script = perl_script_find(name); + if (script == NULL) { + printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, + TXT_SCRIPT_NOT_LOADED, name); + } else { + printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, + TXT_SCRIPT_UNLOADED, script->name); + perl_script_unload(script); + } + cmd_params_free(free_arg); +} + +static void cmd_script_reset(const char *data) +{ + void *free_arg; + GHashTable *optlist; + + if (!cmd_get_params(data, &free_arg, 0 | PARAM_FLAG_OPTIONS, + "script reset", &optlist)) + return; + + perl_scripts_deinit(); + perl_scripts_init(); + + if (g_hash_table_lookup(optlist, "autorun") != NULL) + perl_scripts_autorun(); + + cmd_params_free(free_arg); +} + +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_CLIENTCRAP, + 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_CLIENTCRAP, + TXT_SCRIPT_LIST_LINE, rec->name, data->str); + } + g_string_free(data, TRUE); + + printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP, + TXT_SCRIPT_LIST_FOOTER); +} + +static void cmd_load(const char *data, SERVER_REC *server, void *item) +{ + char *rootmodule, *submodule; + void *free_arg; + size_t len; + + if (!cmd_get_params(data, &free_arg, 2 , &rootmodule, &submodule)) + return; + + len = strlen(rootmodule); + if (len > 3 && g_strcmp0(rootmodule + len - 3, ".pl") == 0) { + /* make /LOAD script.pl work as expected */ + signal_stop(); + cmd_script_load(data); + } + + cmd_params_free(free_arg); +} + +static void sig_script_error(PERL_SCRIPT_REC *script, const char *error) +{ + printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, + TXT_SCRIPT_ERROR, script == NULL ? "??" : 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, g_strdup(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 reset", NULL, (SIGNAL_FUNC) cmd_script_reset); + command_bind("script list", NULL, (SIGNAL_FUNC) cmd_script_list); + command_bind("load", NULL, (SIGNAL_FUNC) cmd_load); + command_set_options("script exec", "permanent"); + command_set_options("script reset", "autorun"); + + 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); + + perl_core_print_script_error(FALSE); + module_register("perl", "fe"); +} + +void fe_perl_deinit(void) +{ + theme_unregister(); + + 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 reset", (SIGNAL_FUNC) cmd_script_reset); + command_unbind("script list", (SIGNAL_FUNC) cmd_script_list); + command_unbind("load", (SIGNAL_FUNC) cmd_load); + + signal_remove("script error", (SIGNAL_FUNC) sig_script_error); + signal_remove("complete command script load", (SIGNAL_FUNC) sig_complete_load); + signal_remove("complete command script unload", (SIGNAL_FUNC) sig_complete_unload); + + perl_core_print_script_error(TRUE); +} + +void fe_perl_abicheck(int *version) +{ + *version = IRSSI_ABI_VERSION; +} diff --git a/src/perl/perl-signals.c b/src/perl/perl-signals.c new file mode 100644 index 0000000..683b4c3 --- /dev/null +++ b/src/perl/perl-signals.c @@ -0,0 +1,744 @@ +/* + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#define NEED_PERL_H +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/commands.h> +#include <irssi/src/core/modules.h> +#include <irssi/src/core/servers.h> +#include <irssi/src/core/signals.h> +#include <irssi/src/fe-common/core/formats.h> + +#include <irssi/src/perl/perl-core.h> +#include <irssi/src/perl/perl-common.h> +#include <irssi/src/perl/perl-signals.h> + +typedef struct { + PERL_SCRIPT_REC *script; + int signal_id; + char *signal; + SV *func; +} PERL_SIGNAL_REC; + +typedef struct { + char *signal; + char *args[SIGNAL_MAX_ARGUMENTS + 1]; + int dynamic; +} PERL_SIGNAL_ARGS_REC; + +#include "perl-signals-list.h" + +static GHashTable *signals, *signal_stashes; +static GHashTable *perl_signal_args_hash; +static GSList *perl_signal_args_partial; + +void irssi_add_signal_arg_conv(const char *stash, PERL_BLESS_FUNC func) +{ + if (g_hash_table_lookup(signal_stashes, stash) == NULL) + g_hash_table_insert(signal_stashes, g_strdup(stash), func); +} + +static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id) +{ + PERL_SIGNAL_ARGS_REC *rec; + GSList *tmp; + const char *signame; + + rec = g_hash_table_lookup(perl_signal_args_hash, + GINT_TO_POINTER(signal_id)); + if (rec != NULL) return rec; + + /* try to find by name */ + signame = signal_get_id_str(signal_id); + for (tmp = perl_signal_args_partial; tmp != NULL; tmp = tmp->next) { + rec = tmp->data; + + if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0) + return rec; + } + + return NULL; +} + +void perl_signal_args_to_c(void (*callback)(void *, int, void **), void *cb_arg, int signal_id, + SV **args, size_t n_args) +{ + union { + int v_int; + unsigned long v_ulong; + GSList *v_gslist; + GList *v_glist; + GString *v_gstring; + } saved_args[SIGNAL_MAX_ARGUMENTS]; + AV *aargs; + void *p[SIGNAL_MAX_ARGUMENTS]; + PERL_SIGNAL_ARGS_REC *rec; + char *arglist[MAX_FORMAT_PARAMS]; + size_t n; + + if (!(rec = perl_signal_args_find(signal_id))) { + const char *name = signal_get_id_str(signal_id); + if (!name) { + croak("%d is not a known signal id", signal_id); + } + croak("\"%s\" is not a registered signal", name); + } + + for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) { + void *c_arg; + SV *arg = args[n]; + + if (g_strcmp0(rec->args[n], "formatnum_args") == 0 && n >= 3) { + const FORMAT_REC *formats; + const char *module; + int num; + int formatnum; + + module = SvPV_nolen(args[n - 2]); + formatnum = format_find_tag(module, SvPV_nolen(arg)); + if (formatnum < 0) { /* format out of bounds */ + p[n - 2] = NULL; + break; + } + + formats = g_hash_table_lookup(default_formats, module); + arglist[formats[formatnum].params] = NULL; + + p[n++] = GINT_TO_POINTER(formatnum); + + for (num = 0; num < formats[formatnum].params; num++) { + if (n + num < n_args) + arglist[num] = SvPV_nolen(args[n + num]); + else + arglist[num] = ""; + } + + p[n++] = arglist; + n_args = n; + + break; + } else if (!SvOK(arg)) { + c_arg = NULL; + } else if (g_strcmp0(rec->args[n], "string") == 0) { + c_arg = SvPV_nolen(arg); + } else if (g_strcmp0(rec->args[n], "int") == 0) { + c_arg = (void *) SvIV(arg); + } else if (g_strcmp0(rec->args[n], "ulongptr") == 0) { + saved_args[n].v_ulong = SvUV(arg); + c_arg = &saved_args[n].v_ulong; + } else if (g_strcmp0(rec->args[n], "intptr") == 0) { + saved_args[n].v_int = SvIV(SvRV(arg)); + c_arg = &saved_args[n].v_int; + } else if (g_strcmp0(rec->args[n], "gstring") == 0) { + char *pv; + size_t len; + + pv = SvPV(SvRV(arg), len); + c_arg = saved_args[n].v_gstring = g_string_new_len(pv, len); + } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) { + GList *gl; + int is_str; + AV *av; + SV *t; + int count; + + t = SvRV(arg); + if (SvTYPE(t) != SVt_PVAV) { + croak("Not an ARRAY reference"); + } + av = (AV *) t; + + is_str = g_strcmp0(rec->args[n] + 9, "string") == 0 || + g_strcmp0(rec->args[n] + 9, "char*") == 0; /* deprecated form */ + + gl = NULL; + count = av_len(av) + 1; + while (count-- > 0) { + SV **px = av_fetch(av, count, 0); + SV *x = px ? *px : NULL; + gl = g_list_prepend(gl, x == NULL ? + NULL : + is_str ? g_strdup(SvPV_nolen(x)) : + irssi_ref_object(x)); + } + saved_args[n].v_glist = gl; + c_arg = &saved_args[n].v_glist; + } else if (strncmp(rec->args[n], "gslist_", 7) == 0) { + GSList *gsl; + AV *av; + SV *t; + int count; + + t = SvRV(arg); + if (SvTYPE(t) != SVt_PVAV) { + croak("Not an ARRAY reference"); + } + av = (AV *) t; + + gsl = NULL; + count = av_len(av) + 1; + while (count-- > 0) { + SV **x = av_fetch(av, count, 0); + gsl = g_slist_prepend(gsl, x == NULL ? NULL : irssi_ref_object(*x)); + } + c_arg = saved_args[n].v_gslist = gsl; + } else { + c_arg = irssi_ref_object(arg); + } + + p[n] = c_arg; + } + + for (; n < SIGNAL_MAX_ARGUMENTS; ++n) { + p[n] = NULL; + } + + /* make a copy of the stack now, since the callback might change it */ + aargs = av_make(n_args, args); + + callback(cb_arg, n_args, p); + + for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) { + SV *arg = *av_fetch(aargs, n, 0); + + if (!SvOK(arg)) { + continue; + } + + if (g_strcmp0(rec->args[n], "intptr") == 0) { + SV *t = SvRV(arg); + SvIOK_only(t); + SvIV_set(t, saved_args[n].v_int); + } else if (g_strcmp0(rec->args[n], "gstring") == 0) { + GString *str; + SV *t; + + str = saved_args[n].v_gstring; + t = SvRV(arg); + SvPOK_only(t); + sv_setpvn(t, str->str, str->len); + + g_string_free(str, TRUE); + } else if (strncmp(rec->args[n], "gslist_", 7) == 0) { + g_slist_free(saved_args[n].v_gslist); + } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) { + int is_iobject, is_str; + AV *av; + GList *gl, *tmp; + + is_iobject = g_strcmp0(rec->args[n] + 9, "iobject") == 0; + is_str = g_strcmp0(rec->args[n] + 9, "string") == 0 || + g_strcmp0(rec->args[n] + 9, "char*") == 0; /* deprecated form */ + + av = (AV *) SvRV(arg); + av_clear(av); + + gl = saved_args[n].v_glist; + for (tmp = gl; tmp != NULL; tmp = tmp->next) { + av_push(av, is_iobject ? + iobject_bless((SERVER_REC *) tmp->data) : + is_str ? + new_pv(tmp->data) : + irssi_bless_plain(rec->args[n] + 9, tmp->data)); + } + + if (is_str) { + g_list_foreach(gl, (GFunc) g_free, NULL); + } + g_list_free(gl); + } + } + av_undef(aargs); +} + +static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func, + int signal_id, gconstpointer *args) +{ + dSP; + + PERL_SIGNAL_ARGS_REC *rec; + SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS]; + AV *av; + void *arg; + int n; + + + ENTER; + SAVETMPS; + + PUSHMARK(sp); + + /* push signal argument to perl stack */ + rec = perl_signal_args_find(signal_id); + + memset(saved_args, 0, sizeof(saved_args)); + for (n = 0; n < SIGNAL_MAX_ARGUMENTS && + rec != NULL && rec->args[n] != NULL; n++) { + arg = (void *) args[n]; + + if (strncmp(rec->args[n], "glistptr_", 9) == 0) { + /* pointer to linked list - push as AV */ + GList *tmp, **ptr; + int is_iobject, is_str; + + is_iobject = g_strcmp0(rec->args[n]+9, "iobject") == 0; + is_str = g_strcmp0(rec->args[n] + 9, "string") == 0 || + g_strcmp0(rec->args[n] + 9, "char*") == 0; /* deprecated form */ + av = newAV(); + + ptr = arg; + for (tmp = *ptr; tmp != NULL; tmp = tmp->next) { + sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) : + is_str ? new_pv(tmp->data) : + irssi_bless_plain(rec->args[n]+9, tmp->data); + av_push(av, sv); + } + + saved_args[n] = perlarg = newRV_noinc((SV *) av); + } else if (g_strcmp0(rec->args[n], "int") == 0) + perlarg = newSViv((IV)arg); + else if (arg == NULL) + perlarg = &PL_sv_undef; + else if (g_strcmp0(rec->args[n], "string") == 0) + perlarg = new_pv(arg); + else if (g_strcmp0(rec->args[n], "ulongptr") == 0) + perlarg = newSViv(*(unsigned long *) arg); + else if (g_strcmp0(rec->args[n], "intptr") == 0) + saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg)); + else if (g_strcmp0(rec->args[n], "gstring") == 0) { + GString *str = arg; + saved_args[n] = perlarg = newRV_noinc(newSVpvn(str->str, str->len)); + } else if (g_strcmp0(rec->args[n], "formatnum_args") == 0 && n >= 3) { + const THEME_REC *theme; + const MODULE_THEME_REC *rec; + const FORMAT_REC *formats; + char *const *tmp; + int formatnum; + + theme = args[n - 3]; + if (theme == NULL) /* no theme */ + continue; + + rec = g_hash_table_lookup(theme->modules, args[n - 2]); + if (rec == NULL) /* no module in theme */ + continue; + + formats = g_hash_table_lookup(default_formats, args[n - 2]); + if (formats == NULL) /* no module in default_formats */ + continue; + + formatnum = GPOINTER_TO_INT(arg); + if (formatnum >= rec->count) /* format out of bounds */ + continue; + + XPUSHs(sv_2mortal(new_pv(formats[formatnum].tag))); + for (tmp = args[n + 1]; *tmp != NULL; tmp++) { + XPUSHs(sv_2mortal(new_pv(*tmp))); + } + + continue; + } else if (strncmp(rec->args[n], "gslist_", 7) == 0) { + /* linked list - push as AV */ + GSList *tmp; + int is_iobject; + + is_iobject = g_strcmp0(rec->args[n]+7, "iobject") == 0; + av = newAV(); + for (tmp = arg; tmp != NULL; tmp = tmp->next) { + sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) : + irssi_bless_plain(rec->args[n]+7, tmp->data); + av_push(av, sv); + } + + perlarg = newRV_noinc((SV *) av); + } else if (g_strcmp0(rec->args[n], "iobject") == 0) { + /* "irssi object" - any struct that has + "int type; int chat_type" as it's first + variables (server, channel, ..) */ + perlarg = iobject_bless((SERVER_REC *) arg); + } else if (g_strcmp0(rec->args[n], "siobject") == 0) { + /* "simple irssi object" - any struct that has + int type; as it's first variable (dcc) */ + perlarg = simple_iobject_bless((SERVER_REC *) arg); + } else { + PERL_BLESS_FUNC bless_func; + + bless_func = g_hash_table_lookup(signal_stashes, rec->args[n]); + if (bless_func != NULL) { + void *a1 = NULL; + void *a2 = NULL; + void *a3 = NULL; + if (g_strcmp0(rec->args[n], "Irssi::TextUI::Line") == 0) { + /* need to find the corresponding buffer */ + int j; + + for (j = n - 1; j >= 0; j--) { + if (g_strcmp0(rec->args[j], + "Irssi::TextUI::TextBufferView") == + 0) { + a1 = (void *) args[j]; + break; + } else if (g_strcmp0(rec->args[j], + "Irssi::UI::Window") == 0) { + a2 = (void *) args[j]; + break; + } + } + } + + perlarg = bless_func(rec->args[n], a1, a2, a3); + } else { + /* blessed object */ + perlarg = plain_bless(arg, rec->args[n]); + } + } + XPUSHs(sv_2mortal(perlarg)); + } + + PUTBACK; + perl_call_sv(func, G_EVAL|G_DISCARD); + SPAGAIN; + + if (SvTRUE(ERRSV)) { + char *error = g_strdup(SvPV_nolen(ERRSV)); + perl_signal_remove_script(script); + signal_emit("script error", 2, script, error); + g_free(error); + rec = NULL; + } + + /* restore arguments the perl script modified */ + for (n = 0; n < SIGNAL_MAX_ARGUMENTS && + rec != NULL && rec->args[n] != NULL; n++) { + arg = (void *) args[n]; + + if (saved_args[n] == NULL) + continue; + + if (g_strcmp0(rec->args[n], "intptr") == 0) { + int *val = arg; + *val = SvIV(SvRV(saved_args[n])); + } else if (g_strcmp0(rec->args[n], "gstring") == 0) { + SV *os, *ns; + GString *str = arg; + + os = sv_2mortal(newSVpvn(str->str, str->len)); + ns = SvRV(saved_args[n]); + if (sv_cmp(os, ns) != 0) { + size_t len; + char *pv = SvPV(ns, len); + + g_string_truncate(str, 0); + g_string_append_len(str, pv, len); + } + } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) { + GList **ret = arg; + GList *out = NULL; + void *val; + int count; + + av = (AV *) SvRV(saved_args[n]); + count = av_len(av); + while (count-- >= 0) { + sv = av_shift(av); + if (SvPOKp(sv)) + val = g_strdup(SvPV_nolen(sv)); + else + val = GINT_TO_POINTER(SvIV(sv)); + + out = g_list_append(out, val); + } + + if (g_strcmp0(rec->args[n] + 9, "string") == 0 || + g_strcmp0(rec->args[n] + 9, "char*") == 0) /* deprecated form */ + g_list_foreach(*ret, (GFunc) g_free, NULL); + g_list_free(*ret); + *ret = out; + } + } + + FREETMPS; + LEAVE; +} + +#if SIGNAL_MAX_ARGUMENTS != 6 +#error SIGNAL_MAX_ARGUMENTS changed - update code +#endif +static void sig_func(const void *p1, const void *p2, + const void *p3, const void *p4, + const void *p5, const void *p6) +{ + PERL_SIGNAL_REC *rec; + PERL_SCRIPT_REC *script; + const void *args[SIGNAL_MAX_ARGUMENTS]; + + args[0] = p1; args[1] = p2; args[2] = p3; + args[3] = p4; args[4] = p5; args[5] = p6; + + rec = signal_get_user_data(); + script = rec->script; + perl_script_ref(script); + perl_call_signal(script, rec->func, signal_get_emitted_id(), args); + perl_script_unref(script); +} + +static void perl_signal_add_full_int(const char *signal, SV *func, + int priority, int command, + const char *category) +{ + PERL_SCRIPT_REC *script; + PERL_SIGNAL_REC *rec; + GSList **siglist; + void *signal_idp; + + g_return_if_fail(signal != NULL); + g_return_if_fail(func != NULL); + + script = perl_script_find_package(perl_get_package()); + g_return_if_fail(script != NULL); + + rec = g_new(PERL_SIGNAL_REC, 1); + rec->script = script; + rec->signal_id = signal_get_uniq_id(signal); + rec->signal = g_strdup(signal); + rec->func = perl_func_sv_inc(func, perl_get_package()); + + if (command || strncmp(signal, "command ", 8) == 0) { + /* we used Irssi::signal_add() instead of + Irssi::command_bind() - oh well, allow this.. */ + command_bind_full(MODULE_NAME, priority, signal+8, -1, + category, sig_func, rec); + } else { + signal_add_full_id(MODULE_NAME, priority, rec->signal_id, + sig_func, rec); + } + + signal_idp = GINT_TO_POINTER(rec->signal_id); + siglist = g_hash_table_lookup(signals, signal_idp); + if (siglist == NULL) { + siglist = g_new0(GSList *, 1); + g_hash_table_insert(signals, signal_idp, siglist); + } + + *siglist = g_slist_append(*siglist, rec); +} + +void perl_signal_add_full(const char *signal, SV *func, int priority) +{ + perl_signal_add_full_int(signal, func, priority, FALSE, NULL); +} + +static void perl_signal_destroy(PERL_SIGNAL_REC *rec) +{ + if (strncmp(rec->signal, "command ", 8) == 0) + command_unbind_full(rec->signal+8, sig_func, rec); + else + signal_remove_id(rec->signal_id, sig_func, rec); + + SvREFCNT_dec(rec->func); + g_free(rec->signal); + g_free(rec); +} + +static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec) +{ + *siglist = g_slist_remove(*siglist, rec); + if (*siglist == NULL) { + g_free(siglist); + g_hash_table_remove(signals, GINT_TO_POINTER(rec->signal_id)); + } + + perl_signal_destroy(rec); +} + +#define sv_func_cmp(f1, f2) \ + ((SvROK(f1) && SvROK(f2) && SvRV(f1) == SvRV(f2)) || \ + (SvPOK(f1) && SvPOK(f2) && \ + g_strcmp0(SvPV_nolen(f1), SvPV_nolen(f2)) == 0)) + +static void perl_signal_remove_list(GSList **list, SV *func) +{ + GSList *tmp; + + for (tmp = *list; tmp != NULL; tmp = tmp->next) { + PERL_SIGNAL_REC *rec = tmp->data; + + if (sv_func_cmp(rec->func, func)) { + perl_signal_remove_list_one(list, rec); + break; + } + } +} + +void perl_signal_remove(const char *signal, SV *func) +{ + GSList **list; + void *signal_idp; + + signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal)); + list = g_hash_table_lookup(signals, signal_idp); + + if (list != NULL) { + func = perl_func_sv_inc(func, perl_get_package()); + perl_signal_remove_list(list, func); + SvREFCNT_dec(func); + } +} + +void perl_command_bind_to(const char *cmd, const char *category, + SV *func, int priority) +{ + char *signal; + + signal = g_strconcat("command ", cmd, NULL); + perl_signal_add_full_int(signal, func, priority, TRUE, category); + g_free(signal); +} + +void perl_command_runsub(const char *cmd, const char *data, + SERVER_REC *server, WI_ITEM_REC *item) +{ + command_runsub(cmd, data, server, item); +} + +void perl_command_unbind(const char *cmd, SV *func) +{ + char *signal; + + /* perl_signal_remove() calls command_unbind() */ + signal = g_strconcat("command ", cmd, NULL); + perl_signal_remove(signal, func); + g_free(signal); +} + +static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script) +{ + GSList *tmp, *next; + + for (tmp = *list; tmp != NULL; tmp = next) { + PERL_SIGNAL_REC *rec = tmp->data; + + next = tmp->next; + if (script == NULL || rec->script == script) { + *list = g_slist_remove(*list, rec); + perl_signal_destroy(rec); + } + } + + if (*list != NULL) + return FALSE; + + g_free(list); + return TRUE; +} + +/* destroy all signals used by script */ +void perl_signal_remove_script(PERL_SCRIPT_REC *script) +{ + g_hash_table_foreach_remove(signals, (GHRFunc) signal_destroy_hash, + script); +} + +void perl_signals_start(void) +{ + signals = g_hash_table_new(NULL, NULL); +} + +void perl_signals_stop(void) +{ + g_hash_table_foreach(signals, (GHFunc) signal_destroy_hash, NULL); + g_hash_table_destroy(signals); + signals = NULL; +} + +static void register_signal_rec(PERL_SIGNAL_ARGS_REC *rec) +{ + if (rec->signal[strlen(rec->signal)-1] == ' ') { + perl_signal_args_partial = + g_slist_append(perl_signal_args_partial, rec); + } else { + int signal_id = signal_get_uniq_id(rec->signal); + g_hash_table_insert(perl_signal_args_hash, + GINT_TO_POINTER(signal_id), rec); + } +} + +void perl_signal_register(const char *signal, const char **args) +{ + PERL_SIGNAL_ARGS_REC *rec; + int i; + + if (perl_signal_args_find(signal_get_uniq_id(signal)) != NULL) + return; + + rec = g_new0(PERL_SIGNAL_ARGS_REC, 1); + for (i = 0; i < SIGNAL_MAX_ARGUMENTS && args[i] != NULL; i++) + rec->args[i] = g_strdup(args[i]); + rec->dynamic = TRUE; + rec->signal = g_strdup(signal); + register_signal_rec(rec); +} + +void perl_signals_init(void) +{ + int n; + + signal_stashes = g_hash_table_new((GHashFunc) g_str_hash, (GCompareFunc) g_str_equal); + perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash, + (GCompareFunc) g_direct_equal); + perl_signal_args_partial = NULL; + + for (n = 0; perl_signal_args[n].signal != NULL; n++) + register_signal_rec(&perl_signal_args[n]); +} + +static void signal_args_free(PERL_SIGNAL_ARGS_REC *rec) +{ + int i; + + if (!rec->dynamic) + return; + + for (i = 0; i < SIGNAL_MAX_ARGUMENTS && rec->args[i] != NULL; i++) + g_free(rec->args[i]); + g_free(rec->signal); + g_free(rec); +} + +static void signal_args_hash_free(void *key, PERL_SIGNAL_ARGS_REC *rec) +{ + signal_args_free(rec); +} + +void perl_signals_deinit(void) +{ + g_slist_foreach(perl_signal_args_partial, + (GFunc) signal_args_free, NULL); + g_slist_free(perl_signal_args_partial); + + g_hash_table_foreach(perl_signal_args_hash, + (GHFunc) signal_args_hash_free, NULL); + g_hash_table_destroy(perl_signal_args_hash); + + g_hash_table_foreach(signal_stashes, (GHFunc) g_free, NULL); + g_hash_table_destroy(signal_stashes); + signal_stashes = NULL; +} diff --git a/src/perl/perl-signals.h b/src/perl/perl-signals.h new file mode 100644 index 0000000..0110b5a --- /dev/null +++ b/src/perl/perl-signals.h @@ -0,0 +1,37 @@ +#ifndef IRSSI_PERL_PERL_SIGNALS_H +#define IRSSI_PERL_PERL_SIGNALS_H + +void perl_signal_args_to_c(void (*callback)(void *, int, void **), void *cb_arg, int signal_id, + SV **args, size_t n_args); + +void perl_signal_add_full(const char *signal, SV *func, int priority); + +void perl_signal_remove(const char *signal, SV *func); +/* remove all signals used by script */ +void perl_signal_remove_script(PERL_SCRIPT_REC *script); + +void perl_command_bind_to(const char *cmd, const char *category, + SV *func, int priority); +#define perl_command_bind_first(cmd, category, func) \ + perl_command_bind_to(cmd, category, func, 0) +#define perl_command_bind(cmd, category, func) \ + perl_command_bind_to(cmd, category, func, 1) +#define perl_command_bind_last(cmd, category, func) \ + perl_command_bind_to(cmd, category, func, 2) + +void perl_command_unbind(const char *cmd, SV *func); + +void perl_command_runsub(const char *cmd, const char *data, + SERVER_REC *server, WI_ITEM_REC *item); + +void irssi_add_signal_arg_conv(const char *stash, PERL_BLESS_FUNC func); + +void perl_signal_register(const char *signal, const char **args); + +void perl_signals_start(void); +void perl_signals_stop(void); + +void perl_signals_init(void); +void perl_signals_deinit(void); + +#endif diff --git a/src/perl/perl-sources.c b/src/perl/perl-sources.c new file mode 100644 index 0000000..9f9ec6b --- /dev/null +++ b/src/perl/perl-sources.c @@ -0,0 +1,187 @@ +/* + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +*/ + +#define NEED_PERL_H +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include <irssi/src/core/signals.h> + +#include <irssi/src/perl/perl-core.h> +#include <irssi/src/perl/perl-common.h> +#include <irssi/src/perl/perl-sources.h> +#include <irssi/src/core/misc.h> + +typedef struct { + PERL_SCRIPT_REC *script; + int tag; + int refcount; + int once; /* run only once */ + + SV *func; + SV *data; +} PERL_SOURCE_REC; + +static GSList *perl_sources; + +static void perl_source_ref(PERL_SOURCE_REC *rec) +{ + rec->refcount++; +} + +static int perl_source_unref(PERL_SOURCE_REC *rec) +{ + if (--rec->refcount != 0) + return TRUE; + + SvREFCNT_dec(rec->data); + SvREFCNT_dec(rec->func); + g_free(rec); + return FALSE; +} + +static void perl_source_destroy(PERL_SOURCE_REC *rec) +{ + perl_sources = g_slist_remove(perl_sources, rec); + + g_source_remove(rec->tag); + rec->tag = -1; + + perl_source_unref(rec); +} + +static int perl_source_event(PERL_SOURCE_REC *rec) +{ + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv_mortalcopy(rec->data)); + PUTBACK; + + perl_source_ref(rec); + perl_script_ref(rec->script); + perl_call_sv(rec->func, G_EVAL|G_DISCARD); + + if (SvTRUE(ERRSV)) { + char *error = g_strdup(SvPV_nolen(ERRSV)); + perl_source_remove_script(rec->script); + signal_emit("script error", 2, rec->script, error); + g_free(error); + } + + perl_script_unref(rec->script); + + if (perl_source_unref(rec) && rec->once) + perl_source_destroy(rec); + + FREETMPS; + LEAVE; + + return 1; +} + +int perl_timeout_add(int msecs, SV *func, SV *data, int once) +{ + PERL_SCRIPT_REC *script; + PERL_SOURCE_REC *rec; + const char *pkg; + + pkg = perl_get_package(); + script = perl_script_find_package(pkg); + g_return_val_if_fail(script != NULL, -1); + + rec = g_new0(PERL_SOURCE_REC, 1); + perl_source_ref(rec); + + rec->once = once; + rec->script = script; + rec->func = perl_func_sv_inc(func, pkg); + rec->data = SvREFCNT_inc(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, SV *func, SV *data, int once) +{ + PERL_SCRIPT_REC *script; + PERL_SOURCE_REC *rec; + const char *pkg; + + pkg = perl_get_package(); + script = perl_script_find_package(pkg); + g_return_val_if_fail(script != NULL, -1); + + rec = g_new0(PERL_SOURCE_REC, 1); + perl_source_ref(rec); + + rec->once = once; + rec->script =script; + rec->func = perl_func_sv_inc(func, pkg); + rec->data = SvREFCNT_inc(data); + + rec->tag = i_input_add_poll(source, G_PRIORITY_DEFAULT, condition, + (GInputFunction) perl_source_event, rec); + + 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_script(PERL_SCRIPT_REC *script) +{ + GSList *tmp, *next; + + for (tmp = perl_sources; tmp != NULL; tmp = next) { + PERL_SOURCE_REC *rec = tmp->data; + + next = tmp->next; + if (rec->script == script) + 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 0000000..0addb35 --- /dev/null +++ b/src/perl/perl-sources.h @@ -0,0 +1,14 @@ +#ifndef IRSSI_PERL_PERL_SOURCES_H +#define IRSSI_PERL_PERL_SOURCES_H + +int perl_timeout_add(int msecs, SV *func, SV *data, int once); +int perl_input_add(int source, int condition, SV *func, SV *data, int once); + +void perl_source_remove(int tag); +/* remove all sources used by script */ +void perl_source_remove_script(PERL_SCRIPT_REC *script); + +void perl_sources_start(void); +void perl_sources_stop(void); + +#endif diff --git a/src/perl/textui/Makefile.PL.in b/src/perl/textui/Makefile.PL.in new file mode 100644 index 0000000..2b0a148 --- /dev/null +++ b/src/perl/textui/Makefile.PL.in @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker;our $AM_DEFAULT_VERBOSITY='@AM_DEFAULT_VERBOSITY@';require "@top_srcdir@/src/perl/Makefile_silent.pm"; + +WriteMakefile('NAME' => 'Irssi::TextUI', + 'LIBS' => '', + 'OBJECT' => '$(O_FILES)', + 'TYPEMAPS' => ['../common/typemap', '../ui/typemap'], + 'INC' => '-I../../.. @GLIB_CFLAGS@', + 'VERSION_FROM' => '@srcdir@/TextUI.pm'); diff --git a/src/perl/textui/Statusbar.xs b/src/perl/textui/Statusbar.xs new file mode 100644 index 0000000..111deaa --- /dev/null +++ b/src/perl/textui/Statusbar.xs @@ -0,0 +1,167 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +static GHashTable *perl_sbar_defs; + +static int check_sbar_destroy(char *key, char *value, char *script) +{ + if (strncmp(value, script, strlen(script)) == 0 && + value[strlen(script)] == ':') { + statusbar_item_unregister(key); + g_free(key); + g_free(value); + return TRUE; + } + + return FALSE; +} + +static void script_unregister_statusbars(PERL_SCRIPT_REC *script) +{ + g_hash_table_foreach_remove(perl_sbar_defs, + (GHRFunc) check_sbar_destroy, + script->package); +} + +void perl_statusbar_init(void) +{ + perl_sbar_defs = g_hash_table_new((GHashFunc) g_str_hash, + (GCompareFunc) g_str_equal); + signal_add("script destroyed", (SIGNAL_FUNC) script_unregister_statusbars); +} + +static void statusbar_item_def_destroy(void *key, void *value) +{ + statusbar_item_unregister(key); + g_free(key); + g_free(value); +} + +void perl_statusbar_deinit(void) +{ + signal_remove("script destroyed", (SIGNAL_FUNC) script_unregister_statusbars); + + g_hash_table_foreach(perl_sbar_defs, + (GHFunc) statusbar_item_def_destroy, NULL); + g_hash_table_destroy(perl_sbar_defs); +} + +static void perl_statusbar_event(char *function, SBAR_ITEM_REC *item, + int get_size_only) +{ + dSP; + SV *item_sv, **sv; + HV *hv; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + item_sv = plain_bless(item, "Irssi::TextUI::StatusbarItem"); + XPUSHs(sv_2mortal(item_sv)); + XPUSHs(sv_2mortal(newSViv(get_size_only))); + PUTBACK; + + perl_call_pv(function, G_EVAL|G_DISCARD); + SPAGAIN; + + if (SvTRUE(ERRSV)) { + PERL_SCRIPT_REC *script; + char *package, *error; + + package = perl_function_get_package(function); + script = perl_script_find_package(package); + g_free(package); + + if (script != NULL) { + /* make sure we don't get back here */ + script_unregister_statusbars(script); + } + + error = g_strdup(SvPV_nolen(ERRSV)); + signal_emit("script error", 2, script, error); + g_free(error); + } else { + /* min_size and max_size can be changed, move them to SBAR_ITEM_REC */ + hv = hvref(item_sv); + if (hv != NULL) { + sv = hv_fetch(hv, "min_size", 8, 0); + if (sv != NULL) item->min_size = SvIV(*sv); + sv = hv_fetch(hv, "max_size", 8, 0); + if (sv != NULL) item->max_size = SvIV(*sv); + } + } + + FREETMPS; + LEAVE; +} + + +static void sig_perl_statusbar(SBAR_ITEM_REC *item, int get_size_only) +{ + char *function; + + function = g_hash_table_lookup(perl_sbar_defs, item->config->name); + if (function != NULL) + perl_statusbar_event(function, item, get_size_only); + else { + /* use default function - this shouldn't actually happen.. */ + statusbar_item_default_handler(item, get_size_only, NULL, "", TRUE); + } +} + +MODULE = Irssi::TextUI::Statusbar PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +statusbar_item_register(name, value, func = NULL) + char *name + char *value + char *func +CODE: + statusbar_item_register(name, value, func == NULL || *func == '\0' ? NULL : sig_perl_statusbar); + if (func != NULL) { + g_hash_table_insert(perl_sbar_defs, g_strdup(name), + g_strdup_printf("%s::%s", perl_get_package(), func)); + } + +void +statusbar_item_unregister(name) + char *name +PREINIT: + gpointer key, value; +CODE: + if (g_hash_table_lookup_extended(perl_sbar_defs, name, &key, &value)) { + g_hash_table_remove(perl_sbar_defs, name); + g_free(key); + g_free(value); + } + statusbar_item_unregister(name); + +void +statusbar_items_redraw(name) + char *name + +void +statusbars_recreate_items() + +#******************************* +MODULE = Irssi::TextUI::Statusbar PACKAGE = Irssi::TextUI::StatusbarItem PREFIX = statusbar_item_ +#******************************* + +void +statusbar_item_default_handler(item, get_size_only, str, data, escape_vars = TRUE) + Irssi::TextUI::StatusbarItem item + int get_size_only + char *str + char *data + int escape_vars +PREINIT: + HV *hv; +CODE: + statusbar_item_default_handler(item, get_size_only, + *str == '\0' ? NULL : str, + data, escape_vars); + hv = hvref(ST(0)); + (void) hv_store(hv, "min_size", 8, newSViv(item->min_size), 0); + (void) hv_store(hv, "max_size", 8, newSViv(item->max_size), 0); diff --git a/src/perl/textui/TextBuffer.xs b/src/perl/textui/TextBuffer.xs new file mode 100644 index 0000000..655dbd3 --- /dev/null +++ b/src/perl/textui/TextBuffer.xs @@ -0,0 +1,110 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include "wrapper_buffer_line.h" +#include <irssi/src/fe-text/textbuffer-formats.h> + +MODULE = Irssi::TextUI::TextBuffer PACKAGE = Irssi +PROTOTYPES: ENABLE + +#******************************* +MODULE = Irssi::TextUI::TextBuffer PACKAGE = Irssi +#******************************* + +int +COLORING_STRIP() +CODE: + RETVAL = COLORING_STRIP; +OUTPUT: + RETVAL + +int +COLORING_EXPAND() +CODE: + RETVAL = COLORING_EXPAND; +OUTPUT: + RETVAL + +int +COLORING_UNEXPAND() +CODE: + RETVAL = COLORING_UNEXPAND; +OUTPUT: + RETVAL + +int +COLORING_RAW() +CODE: + RETVAL = COLORING_RAW; +OUTPUT: + RETVAL + +#******************************* +MODULE = Irssi::TextUI::TextBuffer PACKAGE = Irssi::TextUI::Line PREFIX = textbuffer_line_ +#******************************* + +Irssi::TextUI::Line +textbuffer_line_prev(line) + Irssi::TextUI::Line line +CODE: + RETVAL = perl_wrap_buffer_line(line->buffer, line->line->prev); +OUTPUT: + RETVAL + +Irssi::TextUI::Line +textbuffer_line_next(line) + Irssi::TextUI::Line line +CODE: + RETVAL = perl_wrap_buffer_line(line->buffer, line->line->next); +OUTPUT: + RETVAL + +void +textbuffer_line_get_text(line, coloring) + Irssi::TextUI::Line line + int coloring +PREINIT: + GString *str; + SV *result; +PPCODE: + str = g_string_new(NULL); + textbuffer_line2text(line->buffer, line->line, coloring, str); + result = new_pv(str->str); + XPUSHs(sv_2mortal(result)); + g_string_free(str, TRUE); + +void +textbuffer_line_get_format(line) + Irssi::TextUI::Line line +PREINIT: + HV *hv; + AV *av; + LINE_REC *l; + TEXT_BUFFER_FORMAT_REC *f; + int i; +PPCODE: + hv = newHV(); + l = line->line; + if (l->info.format != NULL) { + f = l->info.format; + (void) hv_store(hv, "module", 6, new_pv(f->module), 0); + (void) hv_store(hv, "format", 6, new_pv(f->format), 0); + (void) hv_store(hv, "server_tag", 10, new_pv(f->server_tag), 0); + (void) hv_store(hv, "target", 6, new_pv(f->target), 0); + (void) hv_store(hv, "nick", 4, new_pv(f->nick), 0); + av = newAV(); + for (i = 0; i < f->nargs; i++) { + av_push(av, new_pv(f->args[i])); + } + (void) hv_store(hv, "args", 4, newRV_noinc((SV *) av), 0); + } else { + (void) hv_store(hv, "text", 4, new_pv(l->info.text), 0); + } + XPUSHs(sv_2mortal(newRV_noinc((SV *) hv))); + +Irssi::UI::LineInfoMeta +textbuffer_line_get_meta(line) + Irssi::TextUI::Line line +CODE: + RETVAL = line->line->info.meta; +OUTPUT: + RETVAL diff --git a/src/perl/textui/TextBufferView.xs b/src/perl/textui/TextBufferView.xs new file mode 100644 index 0000000..e4cfe67 --- /dev/null +++ b/src/perl/textui/TextBufferView.xs @@ -0,0 +1,115 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include "wrapper_buffer_line.h" + +MODULE = Irssi::TextUI::TextBufferView PACKAGE = Irssi::TextUI::TextBuffer PREFIX = textbuffer_ +PROTOTYPES: ENABLE + +#******************************* +MODULE = Irssi::TextUI::TextBufferView PACKAGE = Irssi::TextUI::TextBufferView PREFIX = textbuffer_view_ +#******************************* + +void +textbuffer_view_set_default_indent(view, default_indent, longword_noindent) + Irssi::TextUI::TextBufferView view + int default_indent + int longword_noindent +CODE: + textbuffer_view_set_default_indent(view, default_indent, longword_noindent, NULL); + +void +textbuffer_view_set_hidden_level(view, level) + Irssi::TextUI::TextBufferView view + int level + +void +textbuffer_view_set_scroll(view, scroll) + Irssi::TextUI::TextBufferView view + int scroll + +void +textbuffer_view_clear(view) + Irssi::TextUI::TextBufferView view + +Irssi::TextUI::Line +textbuffer_view_get_lines(view) + Irssi::TextUI::TextBufferView view +CODE: + RETVAL = perl_wrap_buffer_line(view->buffer, textbuffer_view_get_lines(view)); +OUTPUT: + RETVAL + +void +textbuffer_view_scroll(view, lines) + Irssi::TextUI::TextBufferView view + int lines + +void +textbuffer_view_scroll_line(view, line) + Irssi::TextUI::TextBufferView view + Irssi::TextUI::Line line +CODE: + textbuffer_view_scroll_line(view, Line(line)); + +Irssi::TextUI::LineCache +textbuffer_view_get_line_cache(view, line) + Irssi::TextUI::TextBufferView view + Irssi::TextUI::Line line +CODE: + RETVAL = textbuffer_view_get_line_cache(view, Line(line)); +OUTPUT: + RETVAL + +void +textbuffer_view_remove_line(view, line) + Irssi::TextUI::TextBufferView view + Irssi::TextUI::Line line +CODE: + textbuffer_view_remove_line(view, Line(line)); + +void +textbuffer_view_remove_all_lines(view) + Irssi::TextUI::TextBufferView view + +void +textbuffer_view_remove_lines_by_level(view, level) + Irssi::TextUI::TextBufferView view + int level + +void +textbuffer_view_set_bookmark(view, name, line) + Irssi::TextUI::TextBufferView view + char *name + Irssi::TextUI::Line line +CODE: + textbuffer_view_set_bookmark(view, name, Line(line)); + +void +textbuffer_view_set_bookmark_bottom(view, name) + Irssi::TextUI::TextBufferView view + char *name + +Irssi::TextUI::Line +textbuffer_view_get_bookmark(view, name) + Irssi::TextUI::TextBufferView view + char *name +CODE: + RETVAL = perl_wrap_buffer_line(view->buffer, textbuffer_view_get_bookmark(view, name)); +OUTPUT: + RETVAL + +void +textbuffer_view_redraw(view) + Irssi::TextUI::TextBufferView view + +#******************************* +MODULE = Irssi::TextUI::TextBufferView PACKAGE = Irssi::UI::Window +#******************************* + +Irssi::TextUI::TextBufferView +view(window) + Irssi::UI::Window window +CODE: + RETVAL = WINDOW_GUI(window)->view; +OUTPUT: + RETVAL diff --git a/src/perl/textui/TextUI.pm b/src/perl/textui/TextUI.pm new file mode 100644 index 0000000..50f247c --- /dev/null +++ b/src/perl/textui/TextUI.pm @@ -0,0 +1,26 @@ +# +# Perl interface to irssi functions. +# + +package Irssi::TextUI; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +$VERSION = "0.9"; + +require Exporter; +require DynaLoader; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +bootstrap Irssi::TextUI $VERSION if (!Irssi::Core::is_static()); + +Irssi::TextUI::init(); + +Irssi::EXPORT_ALL(); + +1; + diff --git a/src/perl/textui/TextUI.xs b/src/perl/textui/TextUI.xs new file mode 100644 index 0000000..0ebcc7a --- /dev/null +++ b/src/perl/textui/TextUI.xs @@ -0,0 +1,318 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" +#include "wrapper_buffer_line.h" + +void perl_statusbar_init(void); +void perl_statusbar_deinit(void); + +static int initialized = FALSE; + +static SV *buffer_line_bless(TEXT_BUFFER_REC *buffer, LINE_REC *line) +{ + return perl_buffer_line_bless(perl_wrap_buffer_line(buffer, line)); +} + +static void perl_main_window_fill_hash(HV *hv, MAIN_WINDOW_REC *window) +{ + (void) hv_store(hv, "active", 6, plain_bless(window->active, "Irssi::UI::Window"), 0); + + (void) hv_store(hv, "first_line", 10, newSViv(window->first_line), 0); + (void) hv_store(hv, "last_line", 9, newSViv(window->last_line), 0); + (void) hv_store(hv, "width", 5, newSViv(window->width), 0); + (void) hv_store(hv, "height", 6, newSViv(window->height), 0); + + (void) hv_store(hv, "statusbar_lines", 15, newSViv(window->statusbar_lines), 0); +} + +static void perl_text_buffer_fill_hash(HV *hv, TEXT_BUFFER_REC *buffer) +{ + (void) hv_store(hv, "first_line", 10, buffer_line_bless(buffer, buffer->first_line), 0); + (void) hv_store(hv, "lines_count", 11, newSViv(buffer->lines_count), 0); + (void) hv_store(hv, "cur_line", 8, buffer_line_bless(buffer, buffer->cur_line), 0); + (void) hv_store(hv, "last_eol", 8, newSViv(buffer->last_eol), 0); +} + +static void perl_text_buffer_view_fill_hash(HV *hv, TEXT_BUFFER_VIEW_REC *view) +{ + (void) hv_store(hv, "buffer", 6, plain_bless(view->buffer, "Irssi::TextUI::TextBuffer"), 0); + (void) hv_store(hv, "width", 5, newSViv(view->width), 0); + (void) hv_store(hv, "height", 6, newSViv(view->height), 0); + + (void) hv_store(hv, "default_indent", 14, newSViv(view->default_indent), 0); + (void) hv_store(hv, "longword_noindent", 17, newSViv(view->longword_noindent), 0); + (void) hv_store(hv, "scroll", 6, newSViv(view->scroll), 0); + + (void) hv_store(hv, "ypos", 4, newSViv(view->ypos), 0); + + (void) hv_store(hv, "startline", 9, buffer_line_bless(view->buffer, view->startline), 0); + (void) hv_store(hv, "subline", 7, newSViv(view->subline), 0); + (void) hv_store(hv, "hidden_level", 12, newSViv(view->hidden_level), 0); + + (void) hv_store(hv, "bottom_startline", 16, + buffer_line_bless(view->buffer, view->bottom_startline), 0); + (void) hv_store(hv, "bottom_subline", 14, newSViv(view->bottom_subline), 0); + + (void) hv_store(hv, "empty_linecount", 15, newSViv(view->empty_linecount), 0); + (void) hv_store(hv, "bottom", 6, newSViv(view->bottom), 0); +} + +static void perl_line_fill_hash(HV *hv, struct Buffer_Line_Wrapper *line) +{ + (void) hv_store(hv, "info", 4, plain_bless(&Line(line)->info, "Irssi::TextUI::LineInfo"), + 0); +} + +static void perl_line_cache_fill_hash(HV *hv, LINE_CACHE_REC *cache) +{ + (void) hv_store(hv, "last_access", 11, newSViv(cache->last_access), 0); + (void) hv_store(hv, "count", 5, newSViv(cache->count), 0); + /*LINE_CACHE_SUB_REC lines[1];*/ +} + +static void perl_line_info_fill_hash(HV *hv, LINE_INFO_REC *info) +{ + (void) hv_store(hv, "level", 5, newSViv(info->level), 0); + (void) hv_store(hv, "time", 4, newSViv(info->time), 0); +} + +static void perl_statusbar_item_fill_hash(HV *hv, SBAR_ITEM_REC *item) +{ + (void) hv_store(hv, "min_size", 8, newSViv(item->min_size), 0); + (void) hv_store(hv, "max_size", 8, newSViv(item->max_size), 0); + (void) hv_store(hv, "xpos", 4, newSViv(item->xpos), 0); + (void) hv_store(hv, "size", 4, newSViv(item->size), 0); + if (item->bar->parent_window != NULL) + (void) hv_store(hv, "window", 6, plain_bless(item->bar->parent_window->active, "Irssi::UI::Window"), 0); +} + +static SV *perl_line_signal_arg_conv(LINE_REC *line, TEXT_BUFFER_VIEW_REC *view, WINDOW_REC *window) +{ + if (view != NULL) + return buffer_line_bless(view->buffer, line); + else if (window != NULL) + return buffer_line_bless(WINDOW_GUI(window)->view->buffer, line); + else + return &PL_sv_undef; +} + +static PLAIN_OBJECT_INIT_REC textui_plains[] = { + { "Irssi::TextUI::MainWindow", (PERL_OBJECT_FUNC) perl_main_window_fill_hash }, + { "Irssi::TextUI::TextBuffer", (PERL_OBJECT_FUNC) perl_text_buffer_fill_hash }, + { "Irssi::TextUI::TextBufferView", (PERL_OBJECT_FUNC) perl_text_buffer_view_fill_hash }, + { "Irssi::TextUI::Line", (PERL_OBJECT_FUNC) perl_line_fill_hash }, + { "Irssi::TextUI::LineCache", (PERL_OBJECT_FUNC) perl_line_cache_fill_hash }, + { "Irssi::TextUI::LineInfo", (PERL_OBJECT_FUNC) perl_line_info_fill_hash }, + { "Irssi::TextUI::StatusbarItem", (PERL_OBJECT_FUNC) perl_statusbar_item_fill_hash }, + + { NULL, NULL } +}; + +MODULE = Irssi::TextUI PACKAGE = Irssi::TextUI + +PROTOTYPES: ENABLE + +void +init() +CODE: + if (initialized) return; + perl_api_version_check("Irssi::TextUI"); + initialized = TRUE; + + irssi_add_plains(textui_plains); + irssi_add_signal_arg_conv("Irssi::TextUI::Line", + (PERL_BLESS_FUNC) perl_line_signal_arg_conv); + perl_statusbar_init(); + +void +deinit() +CODE: + if (!initialized) return; + perl_statusbar_deinit(); + initialized = FALSE; + +MODULE = Irssi::TextUI PACKAGE = Irssi + +void +gui_printtext(xpos, ypos, str) + int xpos + int ypos + char *str + +void +gui_input_set(str) + char *str +CODE: + gui_entry_set_text(active_entry, str); + +void +gui_input_set_extent(pos, text) + int pos + char *text +PREINIT: + char *tt; +CODE: + tt = text != NULL ? format_string_expand(text, NULL) : NULL; + gui_entry_set_extent(active_entry, pos, tt); + g_free(tt); + +void +gui_input_set_extents(pos, len, left, right) + int pos + int len + char *left + char *right +PREINIT: + char *tl; + char *tr; +CODE: + tl = left != NULL ? format_string_expand(left, NULL) : NULL; + tr = right != NULL ? format_string_expand(right, NULL) : NULL; + gui_entry_set_extents(active_entry, pos, len, tl, tr); + g_free(tl); + g_free(tr); + +void +gui_input_clear_extents(pos, len = 0) + int pos + int len +CODE: + gui_entry_clear_extents(active_entry, pos, len); + +char * +gui_input_get_extent(pos) + int pos +CODE: + RETVAL = gui_entry_get_extent(active_entry, pos); +OUTPUT: + RETVAL + +void +gui_input_get_text_and_extents() +PREINIT: + GSList *ret, *tmp; +PPCODE: + ret = gui_entry_get_text_and_extents(active_entry); + for (tmp = ret; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(new_pv(tmp->data))); + } + g_slist_free_full(ret, g_free); + +void +gui_input_set_text_and_extents(...) +PREINIT: + GSList *list; + int i; +PPCODE: + list = NULL; + for (i = items; i > 0; i--) { + list = g_slist_prepend(list, SvPV_nolen(ST(i-1))); + } + gui_entry_set_text_and_extents(active_entry, list); + g_slist_free(list); + +int +gui_input_get_pos() +CODE: + RETVAL = gui_entry_get_pos(active_entry); +OUTPUT: + RETVAL + +void +gui_input_set_pos(pos) + int pos +CODE: + gui_entry_set_pos(active_entry, pos); + +int +wcwidth(c) + char *c +CODE: + if (term_type == TERM_TYPE_UTF8) { + unichar chr = g_utf8_get_char_validated((const char *) c, -1); + + if (chr & 0x80000000) { + RETVAL = 1; + } else { + RETVAL = i_wcwidth(chr); + } + } else if (term_type != TERM_TYPE_BIG5 || + c[1] == '\0' || + !is_big5((unsigned char) c[0], (unsigned char) c[1])) { + RETVAL = i_wcwidth((unsigned char) *c); + } else { + RETVAL = 2; + } +OUTPUT: + RETVAL + +MODULE = Irssi::TextUI PACKAGE = Irssi::UI::Window + +void +print_after(window, prev, level, str, time = 0) + Irssi::UI::Window window + Irssi::TextUI::Line prev + int level + char *str + time_t time +PREINIT: + TEXT_DEST_REC dest; + char *text; + char *text2; +CODE: + format_create_dest(&dest, NULL, NULL, level, window); + text = format_string_expand(str, NULL); + text2 = g_strconcat(text, "\n", NULL); + gui_printtext_after_time(&dest, Line(prev), text2, time); + g_free(text); + g_free(text2); + +void +gui_printtext_after(window, prev, level, str, time = 0) + Irssi::UI::Window window + Irssi::TextUI::Line prev + int level + char *str + time_t time +PREINIT: + TEXT_DEST_REC dest; +CODE: + format_create_dest(&dest, NULL, NULL, level, window); + gui_printtext_after_time(&dest, Line(prev), str, time); + +Irssi::TextUI::Line +last_line_insert(window) + Irssi::UI::Window window +CODE: + RETVAL = perl_wrap_buffer_line(WINDOW_GUI(window)->view->buffer, + WINDOW_GUI(window)->insert_after); +OUTPUT: + RETVAL + +MODULE = Irssi::TextUI PACKAGE = Irssi::Server + +void +gui_printtext_after(server, target, prev, level, str, time = 0) + Irssi::Server server + char *target + Irssi::TextUI::Line prev + int level + char *str + time_t time +PREINIT: + TEXT_DEST_REC dest; +CODE: + format_create_dest(&dest, server, target, level, NULL); + gui_printtext_after_time(&dest, Line(prev), str, time); + +BOOT: + irssi_boot(TextUI__Statusbar); + irssi_boot(TextUI__TextBuffer); + irssi_boot(TextUI__TextBufferView); + +MODULE = Irssi::TextUI PACKAGE = Irssi + +void +term_refresh_freeze() + +void +term_refresh_thaw() diff --git a/src/perl/textui/meson.build b/src/perl/textui/meson.build new file mode 100644 index 0000000..429e988 --- /dev/null +++ b/src/perl/textui/meson.build @@ -0,0 +1,37 @@ +libperl_Irssi_TextUI_a = shared_module('TextUI', + [ xsubpp.process( + files( + 'Statusbar.xs', + 'TextBufferView.xs', + 'TextBuffer.xs', + 'TextUI.xs', + ), + extra_args : [ + '-typemap', + '../common/typemap', + '-typemap', + '../ui/typemap', + ], + ) ] + + files( + 'module.h', + ), + name_prefix : '', + name_suffix : perl_module_suffix, + install : true, + install_dir : perlmoddir / 'auto' / 'Irssi' / 'TextUI', + include_directories : rootinc, + implicit_include_directories : true, + dependencies : dep + [ perl_dep ], + link_with : dl_cross_perl_core, +) + +install_headers( + files( + 'TextUI.pm', + ), + install_dir : perlmoddir / 'Irssi', +) + +# 'Makefile.PL.in', +# 'typemap', diff --git a/src/perl/textui/module.h b/src/perl/textui/module.h new file mode 100644 index 0000000..aba5bd7 --- /dev/null +++ b/src/perl/textui/module.h @@ -0,0 +1,17 @@ +#include <irssi/src/perl/ui/module.h> + +#include <irssi/src/fe-text/mainwindows.h> +#include <irssi/src/fe-text/gui-windows.h> +#include <irssi/src/fe-text/gui-printtext.h> +#include <irssi/src/fe-text/statusbar.h> +#include <irssi/src/fe-text/textbuffer.h> +#include <irssi/src/fe-text/textbuffer-view.h> +#include <irssi/src/fe-text/gui-entry.h> + +typedef MAIN_WINDOW_REC *Irssi__TextUI__MainWindow; +typedef TEXT_BUFFER_REC *Irssi__TextUI__TextBuffer; +typedef TEXT_BUFFER_VIEW_REC *Irssi__TextUI__TextBufferView; +typedef struct Buffer_Line_Wrapper *Irssi__TextUI__Line; +typedef LINE_CACHE_REC *Irssi__TextUI__LineCache; +typedef LINE_INFO_REC *Irssi__TextUI__LineInfo; +typedef SBAR_ITEM_REC *Irssi__TextUI__StatusbarItem; diff --git a/src/perl/textui/typemap b/src/perl/textui/typemap new file mode 100644 index 0000000..e597c58 --- /dev/null +++ b/src/perl/textui/typemap @@ -0,0 +1,24 @@ +TYPEMAP +Irssi::TextUI::MainWindow T_PlainObj +Irssi::TextUI::TextBuffer T_PlainObj +Irssi::TextUI::TextBufferView T_PlainObj +Irssi::TextUI::Line T_BufferLineWrapper +Irssi::TextUI::LineCache T_PlainObj +Irssi::TextUI::LineInfo T_PlainObj +Irssi::TextUI::StatusbarItem T_PlainObj + +INPUT + +T_PlainObj + $var = irssi_ref_object($arg) + +T_BufferLineWrapper + $var = irssi_ref_buffer_line_wrap($arg) + +OUTPUT + +T_PlainObj + $arg = plain_bless($var, \"$ntype\"); + +T_BufferLineWrapper + $arg = perl_buffer_line_bless($var); diff --git a/src/perl/textui/wrapper_buffer_line.h b/src/perl/textui/wrapper_buffer_line.h new file mode 100644 index 0000000..3431065 --- /dev/null +++ b/src/perl/textui/wrapper_buffer_line.h @@ -0,0 +1,90 @@ +#ifndef IRSSI_PERL_TEXTUI_WRAPPER_BUFFER_LINE_H +#define IRSSI_PERL_TEXTUI_WRAPPER_BUFFER_LINE_H + +/* This Buffer_Line_Wrapper is a compatibility shim so that the Perl + * API does not change in Irssi ABI 24 even though the C API was + * changed. That way scripts can continue to work unchanged. */ + +struct Buffer_Line_Wrapper { + LINE_REC *line; + TEXT_BUFFER_REC *buffer; +}; + +#define Line(wrapper) ((wrapper) == NULL ? NULL : (wrapper)->line) + +static int magic_free_buffer_line(pTHX_ SV *sv, MAGIC *mg) +{ + struct Buffer_Line_Wrapper *wrap = (struct Buffer_Line_Wrapper *) mg->mg_ptr; + g_free(wrap); + mg->mg_ptr = NULL; + sv_setiv(sv, 0); + return 0; +} + +static MGVTBL vtbl_free_buffer_line = { NULL, NULL, NULL, NULL, magic_free_buffer_line }; + +static struct Buffer_Line_Wrapper *perl_wrap_buffer_line(TEXT_BUFFER_REC *buffer, LINE_REC *line) +{ + struct Buffer_Line_Wrapper *wrap; + + if (line == NULL) + return NULL; + + wrap = g_new0(struct Buffer_Line_Wrapper, 1); + wrap->buffer = buffer; + wrap->line = line; + + return wrap; +} + +/* This function is more or less a copy of plain_bless, but with a + special divertion to put the wrapper in _wrapper and the original + line pointer in _irssi, in order to stay compatible with signals + and scripts */ +static SV *perl_buffer_line_bless(struct Buffer_Line_Wrapper *object) +{ + SV *ret, **tmp; + HV *hv; + const char *stash = "Irssi::TextUI::Line"; + + if (object == NULL) + return &PL_sv_undef; + + ret = irssi_bless_plain(stash, object); + hv = hvref(ret); + + tmp = hv_fetch(hv, "_irssi", 6, 0); + + sv_magic(*tmp, NULL, '~', NULL, 0); + + SvMAGIC(*tmp)->mg_private = 0x1551; /* HF */ + SvMAGIC(*tmp)->mg_virtual = &vtbl_free_buffer_line; + SvMAGIC(*tmp)->mg_ptr = (char *) object; + + (void) hv_store(hv, "_wrapper", 8, *tmp, 0); + /* We have to put the Line Pointer in _irssi, not the + compatibility wrapper */ + *tmp = newSViv((IV) object->line); + return ret; +} + +/* This function is a copy of irssi_ref_object, but looking up the + wrapper object in _wrapper instead */ +static void *irssi_ref_buffer_line_wrap(SV *o) +{ + SV **sv; + HV *hv; + void *p; + + hv = hvref(o); + if (hv == NULL) + return NULL; + + sv = hv_fetch(hv, "_wrapper", 8, 0); + if (sv == NULL) + croak("variable is damaged"); + p = GINT_TO_POINTER(SvIV(*sv)); + return p; +} + +#endif diff --git a/src/perl/ui/Formats.xs b/src/perl/ui/Formats.xs new file mode 100644 index 0000000..0f8b59b --- /dev/null +++ b/src/perl/ui/Formats.xs @@ -0,0 +1,177 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +static int magic_free_text_dest(pTHX_ SV *sv, MAGIC *mg) +{ + TEXT_DEST_REC *dest = (TEXT_DEST_REC *) mg->mg_ptr; + char *target = (char *) dest->target; + g_free(target); + g_free(dest); + mg->mg_ptr = NULL; + sv_setiv(sv, 0); + return 0; +} + +static MGVTBL vtbl_free_text_dest = +{ + NULL, NULL, NULL, NULL, magic_free_text_dest +}; + +static SV *perl_format_create_dest(SERVER_REC *server, char *target, + int level, WINDOW_REC *window) +{ + TEXT_DEST_REC *dest; + SV *sv, *ret_sv; + + dest = g_new0(TEXT_DEST_REC, 1); + format_create_dest(dest, server, g_strdup(target), level, window); + + ret_sv = plain_bless(dest, "Irssi::UI::TextDest"); + + sv = *hv_fetch(hvref(ret_sv), "_irssi", 6, 0); + sv_magic(sv, NULL, '~', NULL, 0); + + SvMAGIC(sv)->mg_private = 0x1551; /* HF */ + SvMAGIC(sv)->mg_virtual = &vtbl_free_text_dest; + SvMAGIC(sv)->mg_ptr = (char *) dest; + + return ret_sv; +} + +MODULE = Irssi::UI::Formats PACKAGE = Irssi +PROTOTYPES: ENABLE + +int +format_get_length(str) + char *str + +int +format_real_length(str, len) + char *str + int len + +void +format_string_expand(str) + char *str +PREINIT: + char *ret; +PPCODE: + ret = format_string_expand(str, NULL); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +void +strip_codes(input) + char *input +PREINIT: + char *ret; +PPCODE: + ret = strip_codes(input); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +void +format_string_unexpand(input) + char *input +PREINIT: + char *ret; +PPCODE: + ret = format_string_unexpand(input, 0); + XPUSHs(sv_2mortal(new_pv(ret))); + g_free(ret); + +void +format_create_dest(target, level=MSGLEVEL_CLIENTNOTICE, window=NULL) + char *target + int level + Irssi::UI::Window window +PPCODE: + XPUSHs(sv_2mortal(perl_format_create_dest(NULL, target, level, window))); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::UI::Window +#******************************* + +void +format_get_text(window, module, server, target, format, ...) + Irssi::UI::Window window + char *module + Irssi::Server server + char *target + char *format +PREINIT: + TEXT_DEST_REC dest; + THEME_REC *theme; + char **charargs; + char *ret; + int formatnum; + int n; +PPCODE: + charargs = g_new0(char *, items-5+1); + for (n = 5; n < items; n++) { + charargs[n-5] = SvPV_nolen(ST(n)); + } + + format_create_dest(&dest, server, target, 0, window); + theme = window_get_theme(dest.window); + formatnum = format_find_tag(module, format); + + ret = format_get_text_theme_charargs(theme, module, &dest, formatnum, charargs); + g_free(charargs); + + XPUSHs(sv_2mortal(new_pv(ret))); + g_free_not_null(ret); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::UI::Window +#******************************* + +void +format_create_dest(window=NULL, level=MSGLEVEL_CLIENTNOTICE) + Irssi::UI::Window window + int level +PPCODE: + XPUSHs(sv_2mortal(perl_format_create_dest(NULL, NULL, level, window))); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::Server +#******************************* + +void +format_create_dest(server, target=NULL, level=MSGLEVEL_CLIENTNOTICE, window=NULL) + Irssi::Server server + char *target + int level + Irssi::UI::Window window +PPCODE: + XPUSHs(sv_2mortal(perl_format_create_dest(server, target, level, window))); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::UI::TextDest +#******************************* + +void +print(dest, str) + Irssi::UI::TextDest dest + char *str +CODE: + printtext_dest(dest, "%s", str); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::UI::TextDest PREFIX = format_dest_ +#******************************* + +void +format_dest_meta_stash(dest, meta_key, meta_value) + Irssi::UI::TextDest dest + char *meta_key + char *meta_value + +char * +format_dest_meta_stash_find(dest, meta_key) + Irssi::UI::TextDest dest + char *meta_key +CODE: + RETVAL = (char *) format_dest_meta_stash_find(dest, meta_key); +OUTPUT: + RETVAL diff --git a/src/perl/ui/Makefile.PL.in b/src/perl/ui/Makefile.PL.in new file mode 100644 index 0000000..9507e74 --- /dev/null +++ b/src/perl/ui/Makefile.PL.in @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker;our $AM_DEFAULT_VERBOSITY='@AM_DEFAULT_VERBOSITY@';require "@top_srcdir@/src/perl/Makefile_silent.pm"; + +WriteMakefile('NAME' => 'Irssi::UI', + 'LIBS' => '', + 'OBJECT' => '$(O_FILES)', + 'TYPEMAPS' => ['../common/typemap'], + 'INC' => '-I../../.. @GLIB_CFLAGS@', + 'VERSION_FROM' => '@srcdir@/UI.pm'); diff --git a/src/perl/ui/Themes.xs b/src/perl/ui/Themes.xs new file mode 100644 index 0000000..e9e5639 --- /dev/null +++ b/src/perl/ui/Themes.xs @@ -0,0 +1,322 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +static void printformat_module_perl(TEXT_DEST_REC *dest, const char *module, char *format, + char **arglist) +{ + int formatnum; + + formatnum = format_find_tag(module, format); + if (formatnum < 0) { + die("printformat(): unregistered format '%s'", format); + return; + } + + printformat_module_dest_charargs(module, dest, formatnum, arglist); +} + +static void printformat_perl(TEXT_DEST_REC *dest, char *format, char **arglist) +{ + char *module; + + module = g_strdup(perl_get_package()); + printformat_module_perl(dest, module, format, arglist); + g_free(module); +} + +static void perl_unregister_theme(const char *package) +{ + FORMAT_REC *formats; + int n; + + formats = g_hash_table_lookup(default_formats, package); + if (formats == NULL) return; + + for (n = 0; formats[n].def != NULL; n++) { + g_free(formats[n].tag); + g_free(formats[n].def); + } + g_free(formats); + theme_unregister_module(package); +} + +static void sig_script_destroyed(PERL_SCRIPT_REC *script) +{ + perl_unregister_theme(script->package); +} + +void perl_themes_init(void) +{ + signal_add("script destroyed", (SIGNAL_FUNC) sig_script_destroyed); +} + +void perl_themes_deinit(void) +{ + signal_remove("script destroyed", (SIGNAL_FUNC) sig_script_destroyed); +} + +MODULE = Irssi::UI::Themes PACKAGE = Irssi +PROTOTYPES: ENABLE + +Irssi::UI::Theme +current_theme() +CODE: + RETVAL = current_theme; +OUTPUT: + RETVAL + +int +EXPAND_FLAG_IGNORE_REPLACES() +CODE: + RETVAL = EXPAND_FLAG_IGNORE_REPLACES; +OUTPUT: + RETVAL + +int +EXPAND_FLAG_IGNORE_EMPTY() +CODE: + RETVAL = EXPAND_FLAG_IGNORE_EMPTY; +OUTPUT: + RETVAL + +int +EXPAND_FLAG_RECURSIVE_MASK() +CODE: + RETVAL = EXPAND_FLAG_RECURSIVE_MASK; +OUTPUT: + RETVAL + +void +theme_register(formats) + SV *formats +PREINIT: + AV *av; + FORMAT_REC *formatrecs; + char *key, *value; + int len, n, fpos; +CODE: + + if (!SvROK(formats)) + croak("formats is not a reference"); + + av = (AV *) SvRV(formats); + if (SvTYPE(av) != SVt_PVAV) + croak("formats is not a reference to a list"); + + len = av_len(av)+1; + if (len == 0 || (len & 1) != 0) + croak("formats list is invalid - not divisible by 2 (%d)", len); + + formatrecs = g_new0(FORMAT_REC, len/2+2); + formatrecs[0].tag = g_strdup(perl_get_package()); + formatrecs[0].def = g_strdup("Perl script"); + + for (fpos = 1, n = 0; n < len; n++, fpos++) { + key = SvPV_nolen(*av_fetch(av, n, 0)); n++; + value = SvPV_nolen(*av_fetch(av, n, 0)); + + formatrecs[fpos].tag = g_strdup(key); + formatrecs[fpos].def = g_strdup(value); + formatrecs[fpos].params = MAX_FORMAT_PARAMS; + } + + theme_register_module(perl_get_package(), formatrecs); + +void +printformat(level, format, ...) + int level + char *format +PREINIT: + TEXT_DEST_REC dest; + char *arglist[MAX_FORMAT_PARAMS+1]; + int n; +CODE: + format_create_dest(&dest, NULL, NULL, level, NULL); + memset(arglist, 0, sizeof(arglist)); + for (n = 2; n < items && n < MAX_FORMAT_PARAMS+2; n++) { + arglist[n-2] = SvPV_nolen(ST(n)); + } + + printformat_perl(&dest, format, arglist); + +void +abstracts_register(abstracts) + SV *abstracts +PREINIT: + AV *av; + char *key, *value; + int i, len; +CODE: + if (!SvROK(abstracts)) + croak("abstracts is not a reference to list"); + av = (AV *) SvRV(abstracts); + len = av_len(av)+1; + if (len == 0 || (len & 1) != 0) + croak("abstracts list is invalid - not divisible by 2 (%d)", len); + + for (i = 0; i < len; i++) { + key = SvPV_nolen(*av_fetch(av, i, 0)); i++; + value = SvPV_nolen(*av_fetch(av, i, 0)); + + theme_set_default_abstract(key, value); + } + themes_reload(); + +void +themes_reload() + +#******************************* +MODULE = Irssi::UI::Themes PACKAGE = Irssi::Server +#******************************* + +void +printformat(server, target, level, format, ...) + Irssi::Server server + char *target + int level + char *format +PREINIT: + TEXT_DEST_REC dest; + char *arglist[MAX_FORMAT_PARAMS+1]; + int n; +CODE: + format_create_dest(&dest, server, target, level, NULL); + memset(arglist, 0, sizeof(arglist)); + for (n = 4; n < items && n < MAX_FORMAT_PARAMS+4; n++) { + arglist[n-4] = SvPV_nolen(ST(n)); + } + + printformat_perl(&dest, format, arglist); + +#******************************* +MODULE = Irssi::UI::Themes PACKAGE = Irssi::UI::Window +#******************************* + +void +printformat(window, level, format, ...) + Irssi::UI::Window window + int level + char *format +PREINIT: + TEXT_DEST_REC dest; + char *arglist[MAX_FORMAT_PARAMS+1]; + int n; +CODE: + format_create_dest(&dest, NULL, NULL, level, window); + memset(arglist, 0, sizeof(arglist)); + for (n = 3; n < items && n < MAX_FORMAT_PARAMS+3; n++) { + arglist[n-3] = SvPV_nolen(ST(n)); + } + + printformat_perl(&dest, format, arglist); + +#******************************* +MODULE = Irssi::UI::Themes PACKAGE = Irssi::Windowitem +#******************************* + +void +printformat(item, level, format, ...) + Irssi::Windowitem item + int level + char *format +PREINIT: + TEXT_DEST_REC dest; + char *arglist[MAX_FORMAT_PARAMS+1]; + int n; +CODE: + format_create_dest(&dest, item->server, item->visible_name, level, NULL); + memset(arglist, 0, sizeof(arglist)); + for (n = 3; n < items && n < MAX_FORMAT_PARAMS+3; n++) { + arglist[n-3] = SvPV_nolen(ST(n)); + } + + printformat_perl(&dest, format, arglist); + +#******************************* +MODULE = Irssi::UI::Formats PACKAGE = Irssi::UI::TextDest +#******************************* + +void +printformat(dest, format, ...) + Irssi::UI::TextDest dest + char *format +PREINIT: + char *arglist[MAX_FORMAT_PARAMS + 1]; + int n; +CODE: + memset(arglist, 0, sizeof(arglist)); + for (n = 2; n < items && n < MAX_FORMAT_PARAMS + 2; n++) { + arglist[n - 2] = SvPV_nolen(ST(n)); + } + + printformat_perl(dest, format, arglist); + +void +printformat_module(dest, module, format, ...) + Irssi::UI::TextDest dest + char *module + char *format +PREINIT: + char *arglist[MAX_FORMAT_PARAMS + 1]; + int n; +CODE: + memset(arglist, 0, sizeof(arglist)); + for (n = 3; n < items && n < MAX_FORMAT_PARAMS + 3; n++) { + arglist[n - 3] = SvPV_nolen(ST(n)); + } + + printformat_module_perl(dest, module, format, arglist); + +#******************************* +MODULE = Irssi::UI::Themes PACKAGE = Irssi::UI::Theme PREFIX = theme_ +#******************************* + +void +theme_format_expand(theme, format, flags=0) + Irssi::UI::Theme theme + char *format + int flags +PREINIT: + char *ret; +PPCODE: + if (flags == 0) { + ret = theme_format_expand(theme, format); + } else { + theme_rm_col reset; + strcpy(reset.m, "n"); + ret = theme_format_expand_data(theme, (const char **) &format, + reset, reset, NULL, NULL, + EXPAND_FLAG_ROOT | flags); + } + XPUSHs(sv_2mortal(new_pv(ret))); + g_free_not_null(ret); + +char * +theme_get_format(theme, module, tag) + Irssi::UI::Theme theme + char *module + char *tag +PREINIT: + MODULE_THEME_REC *modtheme; + FORMAT_REC *formats; + int i; +CODE: + formats = g_hash_table_lookup(default_formats, module); + if (formats == NULL) + croak("Unknown module: %s", module); + + for (i = 0; formats[i].def != NULL; i++) { + if (formats[i].tag != NULL && + g_ascii_strcasecmp(formats[i].tag, tag) == 0) + break; + } + + if (formats[i].def == NULL) + croak("Unknown format tag: %s", tag); + + modtheme = g_hash_table_lookup(theme->modules, module); + RETVAL = modtheme == NULL ? NULL : modtheme->formats[i]; + if (RETVAL == NULL) + RETVAL = formats[i].def; +OUTPUT: + RETVAL diff --git a/src/perl/ui/UI.pm b/src/perl/ui/UI.pm new file mode 100644 index 0000000..83b9ef2 --- /dev/null +++ b/src/perl/ui/UI.pm @@ -0,0 +1,29 @@ +# +# Perl interface to irssi functions. +# + +package Irssi::UI; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +$VERSION = "0.9"; + +require Exporter; +require DynaLoader; + +sub Irssi::UI::Window::create_handle { + goto &Irssi::create_window_handle; +} + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +bootstrap Irssi::UI $VERSION if (!Irssi::Core::is_static()); + +Irssi::UI::init(); + +Irssi::EXPORT_ALL(); + +1; diff --git a/src/perl/ui/UI.xs b/src/perl/ui/UI.xs new file mode 100644 index 0000000..30b0f63 --- /dev/null +++ b/src/perl/ui/UI.xs @@ -0,0 +1,147 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +void perl_themes_init(void); +void perl_themes_deinit(void); + +static int initialized = FALSE; + +static void perl_process_fill_hash(HV *hv, PROCESS_REC *process) +{ + (void) hv_store(hv, "id", 2, newSViv(process->id), 0); + (void) hv_store(hv, "name", 4, new_pv(process->name), 0); + (void) hv_store(hv, "args", 4, new_pv(process->args), 0); + + (void) hv_store(hv, "pid", 3, newSViv(process->pid), 0); + (void) hv_store(hv, "target", 6, new_pv(process->target), 0); + if (process->target_win != NULL) { + (void) hv_store(hv, "target_win", 10, + plain_bless(process->target_win, "Irssi::UI::Window"), 0); + } + (void) hv_store(hv, "shell", 5, newSViv(process->shell), 0); + (void) hv_store(hv, "notice", 6, newSViv(process->notice), 0); + (void) hv_store(hv, "silent", 6, newSViv(process->silent), 0); +} + +static void perl_window_fill_hash(HV *hv, WINDOW_REC *window) +{ + (void) hv_store(hv, "refnum", 6, newSViv(window->refnum), 0); + (void) hv_store(hv, "name", 4, new_pv(window->name), 0); + (void) hv_store(hv, "history_name", 12, new_pv(window->history_name), 0); + + (void) hv_store(hv, "width", 5, newSViv(window->width), 0); + (void) hv_store(hv, "height", 6, newSViv(window->height), 0); + + if (window->active) + (void) hv_store(hv, "active", 6, iobject_bless(window->active), 0); + if (window->active_server) + (void) hv_store(hv, "active_server", 13, iobject_bless(window->active_server), 0); + + (void) hv_store(hv, "servertag", 9, new_pv(window->servertag), 0); + (void) hv_store(hv, "level", 5, newSViv(window->level), 0); + + (void) hv_store(hv, "immortal", 8, newSViv(window->immortal), 0); + (void) hv_store(hv, "sticky_refnum", 13, newSViv(window->sticky_refnum), 0); + + (void) hv_store(hv, "data_level", 10, newSViv(window->data_level), 0); + (void) hv_store(hv, "hilight_color", 13, new_pv(window->hilight_color), 0); + + (void) hv_store(hv, "last_timestamp", 14, newSViv(window->last_timestamp), 0); + (void) hv_store(hv, "last_line", 9, newSViv(window->last_line), 0); + + (void) hv_store(hv, "theme", 5, plain_bless(window->theme, "Irssi::UI::Theme"), 0); + (void) hv_store(hv, "theme_name", 10, new_pv(window->theme_name), 0); +} + +static void perl_text_dest_fill_hash(HV *hv, TEXT_DEST_REC *dest) +{ + (void) hv_store(hv, "window", 6, plain_bless(dest->window, "Irssi::UI::Window"), 0); + (void) hv_store(hv, "server", 6, iobject_bless(dest->server), 0); + (void) hv_store(hv, "target", 6, new_pv(dest->target), 0); + (void) hv_store(hv, "level", 5, newSViv(dest->level), 0); + + (void) hv_store(hv, "hilight_priority", 16, newSViv(dest->hilight_priority), 0); + (void) hv_store(hv, "hilight_color", 13, new_pv(dest->hilight_color), 0); +} + +static void perl_line_info_meta_fill_hash(HV *hv, LINE_INFO_META_REC *meta) +{ + GHashTableIter iter; + char *key; + char *val; + + if (meta != NULL) { + if (meta->hash != NULL) { + g_hash_table_iter_init(&iter, meta->hash); + while ( + g_hash_table_iter_next(&iter, (gpointer *) &key, (gpointer *) &val)) { + (void) hv_store(hv, key, strlen(key), new_pv(val), 0); + } + } + if (meta->server_time) { + (void) hv_store(hv, "server_time", 11, newSViv(meta->server_time), 0); + } + } +} + +static void perl_exec_fill_hash(HV *hv, EXEC_WI_REC *item) +{ + g_return_if_fail(hv != NULL); + g_return_if_fail(item != NULL); + + perl_window_item_fill_hash(hv, (WI_ITEM_REC *) item); + /* we don't bless to Process here to avoid infinite recursion + in the simplistic script binding */ + if (item->process != NULL) { + (void) hv_store(hv, "process_id", 10, newSViv(item->process->id), 0); + } +} + +static PLAIN_OBJECT_INIT_REC fe_plains[] = { + { "Irssi::UI::Process", (PERL_OBJECT_FUNC) perl_process_fill_hash }, + { "Irssi::UI::Window", (PERL_OBJECT_FUNC) perl_window_fill_hash }, + { "Irssi::UI::TextDest", (PERL_OBJECT_FUNC) perl_text_dest_fill_hash }, + { "Irssi::UI::LineInfoMeta", (PERL_OBJECT_FUNC) perl_line_info_meta_fill_hash }, + + { NULL, NULL } +}; + +MODULE = Irssi::UI PACKAGE = Irssi::UI + +PROTOTYPES: ENABLE + +void +processes() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = processes; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::UI::Process"))); + } + + +void +init() +CODE: + if (initialized) return; + perl_api_version_check("Irssi::UI"); + initialized = TRUE; + + irssi_add_plains(fe_plains); + /* window items: fe-exec */ + irssi_add_object(module_get_uniq_id_str("WINDOW ITEM TYPE", "EXEC"), + 0, "Irssi::UI::Exec", + (PERL_OBJECT_FUNC) perl_exec_fill_hash); + perl_themes_init(); + +void +deinit() +CODE: + if (!initialized) return; + perl_themes_deinit(); + initialized = FALSE; + +BOOT: + irssi_boot(UI__Formats); + irssi_boot(UI__Themes); + irssi_boot(UI__Window); diff --git a/src/perl/ui/Window.xs b/src/perl/ui/Window.xs new file mode 100644 index 0000000..d001f38 --- /dev/null +++ b/src/perl/ui/Window.xs @@ -0,0 +1,443 @@ +#define PERL_NO_GET_CONTEXT +#include "module.h" + +#include <irssi/src/fe-common/core/window-activity.h> + +MODULE = Irssi::UI::Window PACKAGE = Irssi +PROTOTYPES: ENABLE + +void +windows() +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = windows; tmp != NULL; tmp = tmp->next) { + XPUSHs(sv_2mortal(plain_bless(tmp->data, "Irssi::UI::Window"))); + } + + +Irssi::UI::Window +active_win() +CODE: + RETVAL = active_win; +OUTPUT: + RETVAL + +Irssi::Server +active_server() +CODE: + RETVAL = active_win->active_server; +OUTPUT: + RETVAL + +void +print(str, level=MSGLEVEL_CLIENTNOTICE) + char *str + int level; +CODE: + printtext_string(NULL, NULL, level, str); + +Irssi::UI::Window +window_find_name(name) + char *name + +Irssi::UI::Window +window_find_refnum(refnum) + int refnum + +int +window_refnum_prev(refnum, wrap) + int refnum + int wrap + +int +window_refnum_next(refnum, wrap) + int refnum + int wrap + +int +windows_refnum_last() + +Irssi::UI::Window +window_find_level(level) + int level +CODE: + RETVAL = window_find_level(NULL, level); +OUTPUT: + RETVAL + +Irssi::UI::Window +window_find_item(name) + char *name +CODE: + RETVAL = window_find_item(NULL, name); +OUTPUT: + RETVAL + +Irssi::UI::Window +window_find_closest(name, level) + char *name + int level +CODE: + RETVAL = window_find_closest(NULL, name, level); +OUTPUT: + RETVAL + +Irssi::Windowitem +window_item_find(name) + char *name +CODE: + RETVAL = window_item_find(NULL, name); +OUTPUT: + RETVAL + + +#******************************* +MODULE = Irssi::UI::Window PACKAGE = Irssi::Server +#******************************* + +void +print(server, channel, str, level=MSGLEVEL_CLIENTNOTICE) + Irssi::Server server + char *channel + char *str + int level +CODE: + printtext_string(server, channel, level, str); + +Irssi::Windowitem +window_item_find(server, name) + Irssi::Server server + char *name + +Irssi::UI::Window +window_find_item(server, name) + Irssi::Server server + char *name + +Irssi::UI::Window +window_find_level(server, level) + Irssi::Server server + int level + +Irssi::UI::Window +window_find_closest(server, name, level) + Irssi::Server server + char *name + int level + + +#******************************* +MODULE = Irssi::UI::Window PACKAGE = Irssi::UI::Window PREFIX=window_ +#******************************* + +void +items(window) + Irssi::UI::Window window +PREINIT: + GSList *tmp; +PPCODE: + for (tmp = window->items; tmp != NULL; tmp = tmp->next) { + CHANNEL_REC *rec = tmp->data; + + XPUSHs(sv_2mortal(iobject_bless(rec))); + } + +void +print(window, str, level=MSGLEVEL_CLIENTNOTICE) + Irssi::UI::Window window + char *str + int level; +CODE: + printtext_string_window(window, level, str); + +void +command(window, cmd) + Irssi::UI::Window window + char *cmd +PREINIT: + WINDOW_REC *old; +CODE: + old = active_win; + active_win = window; + perl_command(cmd, window->active_server, window->active); + if (active_win == window && + g_slist_find(windows, old) != NULL) + active_win = old; + +void +window_item_add(window, item, automatic) + Irssi::UI::Window window + Irssi::Windowitem item + int automatic + +void +window_item_remove(item) + Irssi::Windowitem item + +void +window_item_destroy(item) + Irssi::Windowitem item + +void +window_item_prev(window) + Irssi::UI::Window window + +void +window_item_next(window) + Irssi::UI::Window window + +void +window_destroy(window) + Irssi::UI::Window window + +void +window_set_active(window) + Irssi::UI::Window window + +void +window_change_server(window, server) + Irssi::UI::Window window + Irssi::Server server + +void +window_set_refnum(window, refnum) + Irssi::UI::Window window + int refnum + +void +window_set_name(window, name) + Irssi::UI::Window window + char *name + +void +window_set_history(window, name) + Irssi::UI::Window window + char *name + +void +window_set_level(window, level) + Irssi::UI::Window window + int level + +void +window_activity(window, data_level, hilight_color=NULL) + Irssi::UI::Window window + int data_level + char *hilight_color + +char * +window_get_active_name(window) + Irssi::UI::Window window +CODE: + RETVAL = (char *) window_get_active_name(window); +OUTPUT: + RETVAL + +Irssi::Windowitem +window_item_find(window, server, name) + Irssi::UI::Window window + Irssi::Server server + char *name +CODE: + RETVAL = window_item_find_window(window, server, name); +OUTPUT: + RETVAL + +void +window_get_history_lines(window) + Irssi::UI::Window window +PREINIT: + HISTORY_REC *rec; + GList *tmp; +PPCODE: + rec = command_history_current(window); + for (tmp = command_history_list_first(rec); tmp != NULL; tmp = command_history_list_next(rec, tmp)) + XPUSHs(sv_2mortal(new_pv(((HISTORY_ENTRY_REC *)tmp->data)->text))); + +void +window_get_history_entries(window) + Irssi::UI::Window window +PREINIT: + HISTORY_REC *rec; + HISTORY_ENTRY_REC *ent; + WINDOW_REC *win; + GList *tmp; + GSList *stmp; + HV *hv; +PPCODE: + rec = window == NULL ? NULL : command_history_current(window); + for (tmp = command_history_list_first(rec); tmp != NULL; tmp = command_history_list_next(rec, tmp)) { + hv = (HV*)sv_2mortal((SV*)newHV()); + ent = tmp->data; + hv_store(hv, "text", 4, newSVpv(ent->text, 0), 0); + hv_store(hv, "time", 4, newSViv(ent->time), 0); + if (ent->history == command_history_current(NULL)) { + hv_store(hv, "history", 7, newSV(0), 0); + hv_store(hv, "window", 6, newSV(0), 0); + } else { + if (ent->history->name == NULL) { + hv_store(hv, "history", 7, newSV(0), 0); + for (stmp = windows; stmp != NULL; stmp = stmp->next) { + win = stmp->data; + if (win->history == ent->history) { + hv_store(hv, "window", 6, newSViv(win->refnum), 0); + break; + } + } + } else { + hv_store(hv, "history", 7, new_pv(ent->history->name), 0); + hv_store(hv, "window", 6, newSV(0), 0); + } + } + XPUSHs(sv_2mortal(newRV_inc((SV*)hv))); + } + +void +window_load_history_entries(window, ...) + Irssi::UI::Window window +PREINIT: + HV *hv; + SV **sv; + HISTORY_REC *history; + WINDOW_REC *tmp; + const char *text; + long hist_time; + int i; +PPCODE: + for (i = 1; i < items; i++) { + if (!is_hvref(ST(i))) { + croak("Usage: Irssi::UI::Window::load_history_entries(window, hash...)"); + } + hv = hvref(ST(i)); + if (hv != NULL) { + tmp = NULL; + text = NULL; + hist_time = time(NULL); + history = command_history_current(NULL); + + sv = hv_fetch(hv, "text", 4, 0); + if (sv != NULL) text = SvPV_nolen(*sv); + sv = hv_fetch(hv, "time", 4, 0); + if (sv != NULL && SvOK(*sv)) hist_time = SvIV(*sv); + + if (window != NULL) { + history = command_history_current(window); + } else { + sv = hv_fetch(hv, "history", 7, 0); + if (sv != NULL && SvOK(*sv)) { + history = command_history_find_name(SvPV_nolen(*sv)); + } + + sv = hv_fetch(hv, "window", 6, 0); + if (sv != NULL && SvOK(*sv)) { + tmp = window_find_refnum(SvIV(*sv)); + if (tmp != NULL) { + history = tmp->history; + } + } + } + + if (text != NULL && history != NULL) { + command_history_load_entry(hist_time, history, text); + } + } + } + +void +window_delete_history_entries(window, ...) + Irssi::UI::Window window +PREINIT: + HV *hv; + SV **sv; + HISTORY_REC *history; + WINDOW_REC *tmp; + const char *text; + long hist_time; + int i; +PPCODE: + for (i = 1; i < items; i++) { + if (!is_hvref(ST(i))) { + croak("Usage: Irssi::UI::Window::delete_history_entries(window, hash...)"); + } + hv = hvref(ST(i)); + if (hv != NULL) { + tmp = NULL; + text = NULL; + hist_time = -1; + history = command_history_current(NULL); + + sv = hv_fetch(hv, "text", 4, 0); + if (sv != NULL) text = SvPV_nolen(*sv); + sv = hv_fetch(hv, "time", 4, 0); + if (sv != NULL && SvOK(*sv)) hist_time = SvIV(*sv); + + if (window != NULL) { + history = command_history_current(window); + } else { + sv = hv_fetch(hv, "history", 7, 0); + if (sv != NULL && SvOK(*sv)) { + history = command_history_find_name(SvPV_nolen(*sv)); + } + + sv = hv_fetch(hv, "window", 6, 0); + if (sv != NULL && SvOK(*sv)) { + tmp = window_find_refnum(SvIV(*sv)); + if (tmp != NULL) { + history = tmp->history; + } + } + } + + if (text != NULL && history != NULL) { + XPUSHs(boolSV(command_history_delete_entry(hist_time, history, text))); + } + } + } + +#******************************* +MODULE = Irssi::UI::Window PACKAGE = Irssi::Windowitem PREFIX = window_item_ +#******************************* + +void +print(item, str, level=MSGLEVEL_CLIENTNOTICE) + Irssi::Windowitem item + int level + char *str +CODE: + printtext_string(item->server, item->visible_name, level, str); + +Irssi::UI::Window +window_create(item, automatic) + Irssi::Windowitem item + int automatic + +Irssi::UI::Window +window(item) + Irssi::Windowitem item +CODE: + RETVAL = window_item_window(item); +OUTPUT: + RETVAL + +void +window_item_change_server(item, server) + Irssi::Windowitem item + Irssi::Server server + +int +window_item_is_active(item) + Irssi::Windowitem item + +void +window_item_set_active(item) + Irssi::Windowitem item +CODE: + window_item_set_active(window_item_window(item), item); + +void +window_item_activity(item, data_level, hilight_color=NULL) + Irssi::Windowitem item + int data_level + char *hilight_color + diff --git a/src/perl/ui/meson.build b/src/perl/ui/meson.build new file mode 100644 index 0000000..26ef42e --- /dev/null +++ b/src/perl/ui/meson.build @@ -0,0 +1,35 @@ +libperl_Irssi_UI_a = shared_module('UI', + [ xsubpp.process( + files( + 'Formats.xs', + 'Themes.xs', + 'UI.xs', + 'Window.xs', + ), + extra_args : [ + '-typemap', + '../common/typemap', + ], + ) ] + + files( + 'module.h', + ), + name_prefix : '', + name_suffix : perl_module_suffix, + install : true, + install_dir : perlmoddir / 'auto' / 'Irssi' / 'UI', + include_directories : rootinc, + implicit_include_directories : true, + dependencies : dep + [ perl_dep ], + link_with : dl_cross_perl_core, +) + +install_headers( + files( + 'UI.pm', + ), + install_dir : perlmoddir / 'Irssi', +) + +# 'Makefile.PL.in', +# 'typemap', diff --git a/src/perl/ui/module.h b/src/perl/ui/module.h new file mode 100644 index 0000000..4106aec --- /dev/null +++ b/src/perl/ui/module.h @@ -0,0 +1,15 @@ +#include <irssi/src/perl/common/module.h> + +#include <irssi/src/fe-common/core/fe-windows.h> +#include <irssi/src/fe-common/core/fe-exec.h> +#include <irssi/src/fe-common/core/formats.h> +#include <irssi/src/fe-common/core/printtext.h> +#include <irssi/src/fe-common/core/window-items.h> +#include <irssi/src/fe-common/core/themes.h> +#include <irssi/src/fe-common/core/keyboard.h> + +typedef WINDOW_REC *Irssi__UI__Window; +typedef TEXT_DEST_REC *Irssi__UI__TextDest; +typedef THEME_REC *Irssi__UI__Theme; +typedef KEYINFO_REC *Irssi__UI__Keyinfo; +typedef LINE_INFO_META_REC *Irssi__UI__LineInfoMeta; diff --git a/src/perl/ui/typemap b/src/perl/ui/typemap new file mode 100644 index 0000000..9835519 --- /dev/null +++ b/src/perl/ui/typemap @@ -0,0 +1,17 @@ +TYPEMAP +Irssi::UI::Theme T_PlainObj +Irssi::UI::Window T_PlainObj +Irssi::UI::Keyinfo T_PlainObj +Irssi::UI::TextDest T_PlainObj +Irssi::UI::LineInfoMeta T_PlainObj + +INPUT + +T_PlainObj + $var = irssi_ref_object($arg) + +OUTPUT + +T_PlainObj + $arg = plain_bless($var, \"$ntype\"); + |