1
0
mirror of https://github.com/weechat/weechat.git synced 2026-07-01 07:16:37 +02:00

Perl plugin support

This commit is contained in:
Sebastien Helleu
2003-11-16 19:40:36 +00:00
parent fd9512bbbc
commit d4ec2e46aa
48 changed files with 6986 additions and 5844 deletions
+8 -3
View File
@@ -16,16 +16,21 @@
#
if PLUGIN_PERL
perl_dir=perl
perl_dir = perl
endif
# if PLUGIN_PYTHON
# python_dir=python
# python_dir = python
# endif
# if PLUGIN_RUBY
# ruby_dir=ruby
# ruby_dir = ruby
# endif
# SUBDIRS = $(perl_dir) $(python_dir) $(ruby_dir)
SUBDIRS = $(perl_dir)
noinst_LIBRARIES = lib_weechat_plugins.a
lib_weechat_plugins_a_SOURCES = plugins.h \
plugins.c
+2 -1
View File
@@ -19,4 +19,5 @@ INCLUDES = $(PERL_CFLAGS)
noinst_LIBRARIES = lib_weechat_perl.a
lib_weechat_perl_a_SOURCES = perl.c
lib_weechat_perl_a_SOURCES = wee-perl.h \
wee-perl.c
+302
View File
@@ -0,0 +1,302 @@
/*
* Copyright (c) 2003 by FlashCode <flashcode@flashtux.org>
* Bounga <bounga@altern.org>
* Xahlexx <xahlexx@tuxisland.org>
* See README for License detail.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
/* wee-perl.c: Perl plugin support for WeeChat */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdlib.h>
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "../../common/weechat.h"
#include "wee-perl.h"
#include "../../gui/gui.h"
static PerlInterpreter *my_perl = NULL;
static t_perl_script *perl_scripts = NULL;
extern void boot_DynaLoader (pTHX_ CV* cv);
/*
* IRC::register: startup function for all WeeChat Perl scripts
*/
static XS (XS_IRC_register)
{
char *name, *version, *shutdown_func, *description;
int integer;
t_perl_script *new_perl_script;
dXSARGS;
name = SvPV (ST (0), integer);
version = SvPV (ST (1), integer);
shutdown_func = SvPV (ST (2), integer);
description = SvPV (ST (3), integer);
new_perl_script = (t_perl_script *)malloc (sizeof (t_perl_script));
if (new_perl_script)
{
new_perl_script->name = strdup (name);
new_perl_script->version = strdup (version);
new_perl_script->shutdown_func = strdup (shutdown_func);
new_perl_script->description = strdup (description);
new_perl_script->next_script = perl_scripts;
perl_scripts = new_perl_script;
wee_log_printf (_("registered Perl script: \"%s\"\n"), name);
}
else
gui_printf (NULL,
_("%s unable to load Perl script \"%s\"\n"),
WEECHAT_ERROR, name);
XST_mPV (0, VERSION);
XSRETURN (1);
}
/*
* IRC::print: print message to current window
*/
static XS (XS_IRC_print)
{
int i, integer;
char *message;
dXSARGS;
for (i = 0; i < items; i++)
{
message = SvPV (ST (i), integer);
gui_printf (NULL, "%s\n", message);
}
XSRETURN_EMPTY;
}
/*
* xs_init: initialize subroutines
*/
void
xs_init (pTHX)
{
newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
newXS ("IRC::register", XS_IRC_register, "IRC");
newXS ("IRC::print", XS_IRC_print, "IRC");
}
/*
* wee_perl_init: initialize Perl interface for WeeChat
*/
void
wee_perl_init ()
{
char *perl_args[] = { "", "-e", "0" };
/* This Perl code is extracted/modified from X-Chat IRC client */
/* X-Chat is (c) 1998-2002 Peter Zelezny */
char *weechat_perl_func =
{
"sub wee_perl_load_file"
"{"
" my $filename = shift;"
" local $/ = undef;"
" open FILE, $filename or return \"__WEECHAT_ERROR__\";"
" $_ = <FILE>;"
" close FILE;"
" return $_;"
"}"
"sub wee_perl_load_eval_file"
"{"
" my $filename = shift;"
" my $content = wee_perl_load_file ($filename);"
" if ($content eq \"__WEECHAT_ERROR__\")"
" {"
" IRC::print \"" WEECHAT_ERROR " Perl script '$filename' not found.\\n\";"
" return 1;"
" }"
" eval $content;"
" if ($@)"
" {"
" IRC::print \"" WEECHAT_ERROR " unable to load Perl script '$filename':\\n\";"
" IRC::print \"$@\\n\";"
" return 2;"
" }"
" return 0;"
"}"
"$SIG{__WARN__} = sub { IRC::print \"$_[0]\n\"; };"
};
my_perl = perl_alloc ();
perl_construct (my_perl);
perl_parse (my_perl, xs_init, 3, perl_args, NULL);
eval_pv (weechat_perl_func, TRUE);
}
/*
* wee_perl_search: search a (loaded) Perl script by name
*/
t_perl_script *
wee_perl_search (char *name)
{
t_perl_script *ptr_perl_script;
for (ptr_perl_script = perl_scripts; ptr_perl_script;
ptr_perl_script = ptr_perl_script->next_script)
{
if (strcmp (ptr_perl_script->name, name) == 0)
return ptr_perl_script;
}
/* script not found */
return NULL;
}
/*
* wee_perl_exec: execute a Perl script
*/
int
wee_perl_exec (char *function, char *arguments)
{
char *argv[2];
int count, return_code;
SV *sv;
/* call Perl function */
dSP;
ENTER;
SAVETMPS;
PUSHMARK(sp);
argv[0] = arguments;
argv[1] = NULL;
count = perl_call_argv (function, G_EVAL | G_SCALAR, argv);
SPAGAIN;
/* check if ok */
sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV));
return_code = 1;
if (SvTRUE (sv))
{
gui_printf (NULL,
_("Perl error: %s\n"),
SvPV (sv, count));
POPs;
}
else
{
if (count != 1)
{
gui_printf (NULL,
_("Perl error: too much values from \"%s\" (%d). Expected: 1.\n"),
function, count);
}
else
return_code = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
return return_code;
}
/*
* wee_perl_load: load a Perl script
*/
int
wee_perl_load (char *filename)
{
/* execute Perl script */
wee_log_printf (_("loading Perl script \"%s\"\n"), filename);
return wee_perl_exec ("wee_perl_load_eval_file", filename);
}
/*
* wee_perl_unload: unload a Perl script
*/
void
wee_perl_unload (t_perl_script *ptr_perl_script)
{
if (ptr_perl_script)
{
wee_log_printf (_("unloading Perl script \"%s\"\n"),
ptr_perl_script->name);
/* call shutdown callback function */
if (ptr_perl_script->shutdown_func[0])
wee_perl_exec (ptr_perl_script->shutdown_func, "");
/* free data */
if (ptr_perl_script->name)
free (ptr_perl_script->name);
if (ptr_perl_script->version)
free (ptr_perl_script->version);
if (ptr_perl_script->shutdown_func)
free (ptr_perl_script->shutdown_func);
if (ptr_perl_script->description)
free (ptr_perl_script->description);
}
}
/*
* wee_perl_unload_all: unload all Perl scripts
*/
void
wee_perl_unload_all ()
{
t_perl_script *ptr_perl_script;
while (perl_scripts)
{
wee_perl_unload (perl_scripts);
ptr_perl_script = perl_scripts->next_script;
free (perl_scripts);
perl_scripts = ptr_perl_script;
}
}
/*
* wee_perl_end: shutdown Perl interface
*/
void
wee_perl_end ()
{
/* unload all scripts */
wee_perl_unload_all ();
/* free Perl interpreter */
if (my_perl)
{
perl_destruct (my_perl);
perl_free (my_perl);
}
}
+44
View File
@@ -0,0 +1,44 @@
/*
* Copyright (c) 2003 by FlashCode <flashcode@flashtux.org>
* Bounga <bounga@altern.org>
* Xahlexx <xahlexx@tuxisland.org>
* See README for License detail.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef __WEECHAT_PERL_H
#define __WEECHAT_PERL_H 1
typedef struct t_perl_script t_perl_script;
struct t_perl_script
{
char *name; /* name of script */
char *version; /* version of script */
char *shutdown_func; /* function when script ends */
char *description; /* description of script */
t_perl_script *next_script; /* link to next Perl script */
};
extern void wee_perl_init ();
extern t_perl_script *wee_perl_search (char *);
extern int wee_perl_load (char *);
extern void wee_perl_unload (t_perl_script *);
extern void wee_perl_unload_all ();
extern void wee_perl_end ();
#endif /* wee-perl.h */
+105
View File
@@ -0,0 +1,105 @@
/*
* Copyright (c) 2003 by FlashCode <flashcode@flashtux.org>
* Bounga <bounga@altern.org>
* Xahlexx <xahlexx@tuxisland.org>
* See README for License detail.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
/* plugins.c: manages WeeChat plugins (Perl and/or Python and/or Ruby) */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdlib.h>
#include "plugins.h"
#ifdef PLUGIN_PERL
#include "perl/wee-perl.h"
#endif
/*
* plugins_init: initialize all plugins
*/
void
plugins_init ()
{
#ifdef PLUGIN_PERL
wee_perl_init();
#endif
}
/*
* plugins_load: load a plugin
*/
void
plugins_load (int plugin_type, char *filename)
{
switch (plugin_type)
{
case PLUGIN_PERL:
#ifdef PLUGIN_PERL
wee_perl_load (filename);
#endif
break;
case PLUGIN_PYTHON:
/* TODO: load Python script */
break;
case PLUGIN_RUBY:
/* TODO: load Ruby script */
break;
}
}
/*
* plugins_unload: unload a plugin
*/
void
plugins_unload (int plugin_type, char *scriptname)
{
switch (plugin_type)
{
case PLUGIN_PERL:
#ifdef PLUGIN_PERL
wee_perl_unload (wee_perl_search (scriptname));
#endif
break;
case PLUGIN_PYTHON:
/* TODO: load Python script */
break;
case PLUGIN_RUBY:
/* TODO: load Ruby script */
break;
}
}
/*
* plugins_end: shutdown plugin interface
*/
void
plugins_end ()
{
#ifdef PLUGIN_PERL
wee_perl_end();
#endif
}
+36
View File
@@ -0,0 +1,36 @@
/*
* Copyright (c) 2003 by FlashCode <flashcode@flashtux.org>
* Bounga <bounga@altern.org>
* Xahlexx <xahlexx@tuxisland.org>
* See README for License detail.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef __WEECHAT_PLUGIN_H
#define __WEECHAT_PLUGIN_H 1
#define PLUGIN_UNKNOWN 0
#define PLUGIN_PERL 1
#define PLUGIN_PYTHON 2
#define PLUGIN_RUBY 3
extern void plugins_init ();
extern void plugins_load (int, char *);
extern void plugins_unload (int, char *);
extern void plugins_end ();
#endif /* plugins.h */