mirror of
https://github.com/weechat/weechat.git
synced 2026-06-30 14:56:39 +02:00
New plugin interface (loads dynamic C libraries)
This commit is contained in:
Sebastien Helleu
@@ -0,0 +1,26 @@
|
||||
# Copyright (c) 2003-2005 FlashCode <flashcode@flashtux.org>
|
||||
#
|
||||
# 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
|
||||
#
|
||||
|
||||
INCLUDES = -DLOCALEDIR=\"$(datadir)/locale\" $(PERL_CFLAGS)
|
||||
|
||||
libdir = ${weechat_libdir}/plugins
|
||||
|
||||
lib_LTLIBRARIES = libperl.la
|
||||
|
||||
libperl_la_SOURCES = weechat-perl.c
|
||||
libperl_la_LDFLAGS = -module
|
||||
libperl_la_LIBADD = ../lib_weechat_plugins_scripts.la $(PERL_LFLAGS)
|
||||
@@ -0,0 +1,739 @@
|
||||
/*
|
||||
* Copyright (c) 2003-2005 by FlashCode <flashcode@flashtux.org>
|
||||
* See README for License detail, AUTHORS for developers list.
|
||||
*
|
||||
* 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
|
||||
*/
|
||||
|
||||
/* weechat-perl.c: Perl plugin support for WeeChat */
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <EXTERN.h>
|
||||
#include <perl.h>
|
||||
#include <XSUB.h>
|
||||
#undef _
|
||||
#include "../../weechat-plugin.h"
|
||||
#include "../weechat-script.h"
|
||||
|
||||
|
||||
char plugin_name[] = "Perl";
|
||||
char plugin_version[] = "0.1";
|
||||
char plugin_description[] = "Perl scripts support";
|
||||
|
||||
t_weechat_plugin *perl_plugin;
|
||||
|
||||
t_plugin_script *perl_scripts = NULL;
|
||||
t_plugin_script *current_perl_script = NULL;
|
||||
|
||||
static PerlInterpreter *my_perl = NULL;
|
||||
|
||||
extern void boot_DynaLoader (pTHX_ CV* cv);
|
||||
|
||||
|
||||
/*
|
||||
* weechat_perl_exec: execute a Perl script
|
||||
*/
|
||||
|
||||
int
|
||||
weechat_perl_exec (t_weechat_plugin *plugin,
|
||||
t_plugin_script *script,
|
||||
char *function, char *server, char *arguments)
|
||||
{
|
||||
char empty_server[1] = { '\0' };
|
||||
char *argv[3];
|
||||
unsigned int count;
|
||||
int return_code;
|
||||
SV *sv;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) script;
|
||||
|
||||
dSP;
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(sp);
|
||||
if (!server)
|
||||
argv[0] = empty_server;
|
||||
else
|
||||
argv[0] = server;
|
||||
argv[1] = arguments;
|
||||
argv[2] = NULL;
|
||||
count = perl_call_argv (function, G_EVAL | G_SCALAR, argv);
|
||||
SPAGAIN;
|
||||
|
||||
sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV));
|
||||
return_code = 1;
|
||||
if (SvTRUE (sv))
|
||||
{
|
||||
plugin->printf_server (plugin, "Perl error: %s", SvPV (sv, count));
|
||||
POPs;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (count != 1)
|
||||
{
|
||||
plugin->printf_server (plugin,
|
||||
"Perl error: too much values from \"%s\" (%d). Expected: 1.",
|
||||
function, count);
|
||||
}
|
||||
else
|
||||
return_code = POPi;
|
||||
}
|
||||
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return return_code;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_perl_handler: general message and command handler for Perl
|
||||
*/
|
||||
|
||||
int
|
||||
weechat_perl_handler (t_weechat_plugin *plugin,
|
||||
char *server, char *command, char *arguments,
|
||||
char *handler_args, void *handler_pointer)
|
||||
{
|
||||
/* make gcc happy */
|
||||
(void) command;
|
||||
|
||||
weechat_perl_exec (plugin, (t_plugin_script *)handler_pointer,
|
||||
handler_args, server, arguments);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::register: startup function for all WeeChat Perl scripts
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_register)
|
||||
{
|
||||
char *name, *version, *shutdown_func, *description;
|
||||
unsigned int integer;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) items;
|
||||
(void) cv;
|
||||
|
||||
if (items != 4)
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"register\" function");
|
||||
XSRETURN (0);
|
||||
return;
|
||||
}
|
||||
|
||||
name = SvPV (ST (0), integer);
|
||||
version = SvPV (ST (1), integer);
|
||||
shutdown_func = SvPV (ST (2), integer);
|
||||
description = SvPV (ST (3), integer);
|
||||
|
||||
if (weechat_script_search (perl_plugin, &perl_scripts, name))
|
||||
{
|
||||
/* error: another script already exists with this name! */
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: unable to register "
|
||||
"\"%s\" script (another script "
|
||||
"already exists with this name)",
|
||||
name);
|
||||
XSRETURN (0);
|
||||
return;
|
||||
}
|
||||
|
||||
/* register script */
|
||||
current_perl_script = weechat_script_add (perl_plugin,
|
||||
&perl_scripts,
|
||||
"",
|
||||
name, version, shutdown_func,
|
||||
description);
|
||||
if (current_perl_script)
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl: registered script \"%s\", "
|
||||
"version %s (%s)",
|
||||
name, version, description);
|
||||
}
|
||||
else
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: unable to load script "
|
||||
"\"%s\" (not enough memory)",
|
||||
name);
|
||||
XSRETURN (0);
|
||||
return;
|
||||
}
|
||||
XSRETURN (1);
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::print: print message into a buffer (current or specified one)
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_print)
|
||||
{
|
||||
unsigned int integer;
|
||||
char *message, *channel_name, *server_name;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if ((items < 1) || (items > 3))
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"print\" function");
|
||||
XSRETURN_NO;
|
||||
return;
|
||||
}
|
||||
|
||||
channel_name = NULL;
|
||||
server_name = NULL;
|
||||
|
||||
if (items > 1)
|
||||
{
|
||||
channel_name = SvPV (ST (1), integer);
|
||||
if (items > 2)
|
||||
server_name = SvPV (ST (2), integer);
|
||||
}
|
||||
|
||||
message = SvPV (ST (0), integer);
|
||||
perl_plugin->printf (perl_plugin,
|
||||
server_name, channel_name,
|
||||
"%s", message);
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::print_infobar: print message to infobar
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_print_infobar)
|
||||
{
|
||||
unsigned int integer;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if (items != 2)
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"print_infobar\" function");
|
||||
XSRETURN_NO;
|
||||
}
|
||||
|
||||
perl_plugin->infobar_printf (perl_plugin,
|
||||
SvIV (ST (0)),
|
||||
SvPV (ST (1), integer));
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::command: send command to server
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_command)
|
||||
{
|
||||
unsigned int integer;
|
||||
char *channel_name, *server_name;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if ((items < 1) || (items > 3))
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"command\" function");
|
||||
XSRETURN_NO;
|
||||
return;
|
||||
}
|
||||
|
||||
channel_name = NULL;
|
||||
server_name = NULL;
|
||||
|
||||
if (items > 1)
|
||||
{
|
||||
channel_name = SvPV (ST (1), integer);
|
||||
if (items > 2)
|
||||
server_name = SvPV (ST (2), integer);
|
||||
}
|
||||
|
||||
perl_plugin->exec_command (perl_plugin,
|
||||
server_name, channel_name,
|
||||
SvPV (ST (0), integer));
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::add_message_handler: add handler for messages (privmsg, ...)
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_add_message_handler)
|
||||
{
|
||||
char *name, *function;
|
||||
unsigned int integer;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if (items != 2)
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"add_message_handler\" function");
|
||||
XSRETURN_NO;
|
||||
}
|
||||
|
||||
name = SvPV (ST (0), integer);
|
||||
function = SvPV (ST (1), integer);
|
||||
perl_plugin->msg_handler_add (perl_plugin, name,
|
||||
weechat_perl_handler, function,
|
||||
(void *)current_perl_script);
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::add_command_handler: add command handler (define/redefine commands)
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_add_command_handler)
|
||||
{
|
||||
char *command, *function, *description, *arguments, *arguments_description;
|
||||
unsigned int integer;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if (items < 2)
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"add_command_handler\" function");
|
||||
XSRETURN_NO;
|
||||
}
|
||||
|
||||
command = SvPV (ST (0), integer);
|
||||
function = SvPV (ST (1), integer);
|
||||
description = (items >= 3) ? SvPV (ST (2), integer) : NULL;
|
||||
arguments = (items >= 4) ? SvPV (ST (3), integer) : NULL;
|
||||
arguments_description = (items >= 5) ? SvPV (ST (4), integer) : NULL;
|
||||
|
||||
perl_plugin->cmd_handler_add (perl_plugin,
|
||||
command,
|
||||
description,
|
||||
arguments,
|
||||
arguments_description,
|
||||
weechat_perl_handler,
|
||||
function,
|
||||
(void *)current_perl_script);
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::get_info: get various infos
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_get_info)
|
||||
{
|
||||
char *arg, *info, *server_name, *channel_name;
|
||||
unsigned int integer;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
|
||||
if ((items < 1) || (items > 3))
|
||||
{
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl error: wrong parameters for "
|
||||
"\"get_info\" function");
|
||||
XSRETURN_NO;
|
||||
}
|
||||
|
||||
server_name = NULL;
|
||||
channel_name = NULL;
|
||||
|
||||
if (items >= 2)
|
||||
server_name = SvPV (ST (1), integer);
|
||||
if (items == 3)
|
||||
channel_name = SvPV (ST (2), integer);
|
||||
|
||||
arg = SvPV (ST (0), integer);
|
||||
if (arg)
|
||||
{
|
||||
info = perl_plugin->get_info (perl_plugin, arg, server_name, channel_name);
|
||||
|
||||
if (info)
|
||||
{
|
||||
XST_mPV (0, info);
|
||||
free (info);
|
||||
}
|
||||
else
|
||||
XST_mPV (0, "");
|
||||
}
|
||||
|
||||
XSRETURN (1);
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat::get_dcc_info: get infos about DCC
|
||||
*/
|
||||
|
||||
static XS (XS_weechat_get_dcc_info)
|
||||
{
|
||||
t_plugin_dcc_info *dcc_info, *ptr_dcc;
|
||||
int dcc_count;
|
||||
dXSARGS;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) cv;
|
||||
(void) items;
|
||||
|
||||
dcc_info = perl_plugin->get_dcc_info (perl_plugin);
|
||||
dcc_count = 0;
|
||||
|
||||
if (!dcc_info)
|
||||
{
|
||||
XSRETURN (0);
|
||||
return;
|
||||
}
|
||||
|
||||
for (ptr_dcc = dcc_info; ptr_dcc; ptr_dcc = ptr_dcc->next_dcc)
|
||||
{
|
||||
HV *infohash = (HV *) sv_2mortal((SV *) newHV());
|
||||
|
||||
hv_store (infohash, "server", 6, newSVpv (ptr_dcc->server, 0), 0);
|
||||
hv_store (infohash, "channel", 7, newSVpv (ptr_dcc->channel, 0), 0);
|
||||
hv_store (infohash, "type", 4, newSViv (ptr_dcc->type), 0);
|
||||
hv_store (infohash, "status", 6, newSViv (ptr_dcc->status), 0);
|
||||
hv_store (infohash, "start_time", 10, newSViv (ptr_dcc->start_time), 0);
|
||||
hv_store (infohash, "start_transfer", 14, newSViv (ptr_dcc->start_transfer), 0);
|
||||
hv_store (infohash, "address", 7, newSViv (ptr_dcc->addr), 0);
|
||||
hv_store (infohash, "port", 4, newSViv (ptr_dcc->port), 0);
|
||||
hv_store (infohash, "nick", 4, newSVpv (ptr_dcc->nick, 0), 0);
|
||||
hv_store (infohash, "remote_file", 11, newSVpv (ptr_dcc->filename, 0), 0);
|
||||
hv_store (infohash, "local_file", 10, newSVpv (ptr_dcc->local_filename, 0), 0);
|
||||
hv_store (infohash, "filename_suffix", 15, newSViv (ptr_dcc->filename_suffix), 0);
|
||||
hv_store (infohash, "size", 4, newSVnv (ptr_dcc->size), 0);
|
||||
hv_store (infohash, "pos", 3, newSVnv (ptr_dcc->pos), 0);
|
||||
hv_store (infohash, "start_resume", 12, newSVnv (ptr_dcc->start_resume), 0);
|
||||
hv_store (infohash, "cps", 3, newSViv (ptr_dcc->bytes_per_sec), 0);
|
||||
|
||||
XPUSHs(newRV((SV *) infohash));
|
||||
dcc_count++;
|
||||
}
|
||||
|
||||
perl_plugin->free_dcc_info (perl_plugin, dcc_info);
|
||||
|
||||
XSRETURN (dcc_count);
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_perl_xs_init: initialize subroutines
|
||||
*/
|
||||
|
||||
void
|
||||
weechat_perl_xs_init (pTHX)
|
||||
{
|
||||
newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
|
||||
|
||||
newXS ("weechat::register", XS_weechat_register, "weechat");
|
||||
newXS ("weechat::print", XS_weechat_print, "weechat");
|
||||
newXS ("weechat::print_infobar", XS_weechat_print_infobar, "weechat");
|
||||
newXS ("weechat::command", XS_weechat_command, "weechat");
|
||||
newXS ("weechat::add_message_handler", XS_weechat_add_message_handler, "weechat");
|
||||
newXS ("weechat::add_command_handler", XS_weechat_add_command_handler, "weechat");
|
||||
newXS ("weechat::get_info", XS_weechat_get_info, "weechat");
|
||||
newXS ("weechat::get_dcc_info", XS_weechat_get_dcc_info, "weechat");
|
||||
}
|
||||
|
||||
/*
|
||||
* wee_perl_load: load a Perl script
|
||||
*/
|
||||
|
||||
int
|
||||
weechat_perl_load (t_weechat_plugin *plugin, char *filename)
|
||||
{
|
||||
plugin->printf_server (plugin, "Loading Perl script \"%s\"", filename);
|
||||
return weechat_perl_exec (plugin, NULL, "wee_perl_load_eval_file", filename, "");
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_perl_unload: unload a Perl script
|
||||
*/
|
||||
|
||||
void
|
||||
weechat_perl_unload (t_weechat_plugin *plugin, t_plugin_script *script)
|
||||
{
|
||||
if (script->shutdown_func && script->shutdown_func[0])
|
||||
weechat_perl_exec (plugin, script, script->shutdown_func, "", "");
|
||||
|
||||
weechat_script_remove (plugin, &perl_scripts, script);
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_perl_unload_all: unload all Perl scripts
|
||||
*/
|
||||
|
||||
void
|
||||
weechat_perl_unload_all (t_weechat_plugin *plugin)
|
||||
{
|
||||
plugin->printf_server (plugin,
|
||||
"Unloading all Perl scripts");
|
||||
while (perl_scripts)
|
||||
weechat_perl_unload (plugin, perl_scripts);
|
||||
|
||||
plugin->printf_server (plugin,
|
||||
"Perl scripts unloaded");
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_perl_cmd: /perl command handler
|
||||
*/
|
||||
|
||||
int
|
||||
weechat_perl_cmd (t_weechat_plugin *plugin,
|
||||
char *server, char *command, char *arguments,
|
||||
char *handler_args, void *handler_pointer)
|
||||
{
|
||||
int argc, path_length, handler_found;
|
||||
char **argv, *path_script, *dir_home;
|
||||
t_plugin_script *ptr_plugin_script;
|
||||
t_plugin_msg_handler *ptr_msg_handler;
|
||||
t_plugin_cmd_handler *ptr_cmd_handler;
|
||||
|
||||
/* make gcc happy */
|
||||
(void) server;
|
||||
(void) command;
|
||||
(void) handler_args;
|
||||
(void) handler_pointer;
|
||||
|
||||
argv = plugin->explode_string (plugin, arguments, " ", 0, &argc);
|
||||
|
||||
switch (argc)
|
||||
{
|
||||
case 0:
|
||||
/* list registered Perl scripts */
|
||||
plugin->printf_server (plugin, "");
|
||||
plugin->printf_server (plugin, "Registered Perl scripts:");
|
||||
if (perl_scripts)
|
||||
{
|
||||
for (ptr_plugin_script = perl_scripts; ptr_plugin_script;
|
||||
ptr_plugin_script = ptr_plugin_script->next_script)
|
||||
{
|
||||
plugin->printf_server (plugin, " %s v%s%s%s",
|
||||
ptr_plugin_script->name,
|
||||
ptr_plugin_script->version,
|
||||
(ptr_plugin_script->description[0]) ? " - " : "",
|
||||
ptr_plugin_script->description);
|
||||
}
|
||||
}
|
||||
else
|
||||
plugin->printf_server (plugin, " (none)");
|
||||
|
||||
/* list Perl message handlers */
|
||||
plugin->printf_server (plugin, "");
|
||||
plugin->printf_server (plugin, "Perl message handlers:");
|
||||
handler_found = 0;
|
||||
for (ptr_msg_handler = plugin->msg_handlers; ptr_msg_handler;
|
||||
ptr_msg_handler = ptr_msg_handler->next_handler)
|
||||
{
|
||||
if (ptr_msg_handler->msg_handler_args)
|
||||
{
|
||||
handler_found = 1;
|
||||
plugin->printf_server (plugin, " IRC(%s) => Perl(%s)",
|
||||
ptr_msg_handler->irc_command,
|
||||
ptr_msg_handler->msg_handler_args);
|
||||
}
|
||||
}
|
||||
if (!handler_found)
|
||||
plugin->printf_server (plugin, " (none)");
|
||||
|
||||
/* list Perl command handlers */
|
||||
plugin->printf_server (plugin, "");
|
||||
plugin->printf_server (plugin, "Perl command handlers:");
|
||||
handler_found = 0;
|
||||
for (ptr_cmd_handler = plugin->cmd_handlers; ptr_cmd_handler;
|
||||
ptr_cmd_handler = ptr_cmd_handler->next_handler)
|
||||
{
|
||||
if (ptr_cmd_handler->cmd_handler_args)
|
||||
{
|
||||
handler_found = 1;
|
||||
plugin->printf_server (plugin, " /%s => Perl(%s)",
|
||||
ptr_cmd_handler->command,
|
||||
ptr_cmd_handler->cmd_handler_args);
|
||||
}
|
||||
}
|
||||
if (!handler_found)
|
||||
plugin->printf_server (plugin, " (none)");
|
||||
break;
|
||||
case 1:
|
||||
if (plugin->ascii_strcasecmp (plugin, argv[0], "autoload") == 0)
|
||||
weechat_script_auto_load (plugin, "perl", weechat_perl_load);
|
||||
else if (plugin->ascii_strcasecmp (plugin, argv[0], "reload") == 0)
|
||||
{
|
||||
weechat_perl_unload_all (plugin);
|
||||
weechat_script_auto_load (plugin, "perl", weechat_perl_load);
|
||||
}
|
||||
else if (plugin->ascii_strcasecmp (plugin, argv[0], "unload") == 0)
|
||||
weechat_perl_unload_all (plugin);
|
||||
break;
|
||||
case 2:
|
||||
if (plugin->ascii_strcasecmp (plugin, argv[0], "load") == 0)
|
||||
{
|
||||
/* load Perl script */
|
||||
if ((strstr (argv[1], "/")) || (strstr (argv[1], "\\")))
|
||||
path_script = NULL;
|
||||
else
|
||||
{
|
||||
dir_home = plugin->get_info (plugin, "weechat_dir", NULL, NULL);
|
||||
if (dir_home)
|
||||
{
|
||||
path_length = strlen (dir_home) + strlen (argv[1]) + 16;
|
||||
path_script = (char *) malloc (path_length * sizeof (char));
|
||||
if (path_script)
|
||||
snprintf (path_script, path_length, "%s/perl/%s",
|
||||
dir_home, argv[1]);
|
||||
else
|
||||
path_script = NULL;
|
||||
free (dir_home);
|
||||
}
|
||||
else
|
||||
path_script = NULL;
|
||||
}
|
||||
weechat_perl_load (plugin, (path_script) ? path_script : argv[1]);
|
||||
if (path_script)
|
||||
free (path_script);
|
||||
}
|
||||
else
|
||||
{
|
||||
plugin->printf_server (plugin,
|
||||
"Perl error: unknown option for "
|
||||
"\"perl\" command");
|
||||
}
|
||||
break;
|
||||
default:
|
||||
plugin->printf_server (plugin,
|
||||
"Perl error: wrong argument count for \"perl\" command");
|
||||
}
|
||||
plugin->free_exploded_string (plugin, argv);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_plugin_init: initialize Perl plugin
|
||||
*/
|
||||
|
||||
int
|
||||
weechat_plugin_init (t_weechat_plugin *plugin)
|
||||
{
|
||||
char *perl_args[] = { "", "-e", "0" };
|
||||
/* Following Perl code is extracted/modified from X-Chat IRC client */
|
||||
/* X-Chat is (c) 1998-2005 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__\")"
|
||||
" {"
|
||||
" weechat::print \"Perl error: script '$filename' not found.\", \"\";"
|
||||
" return 1;"
|
||||
" }"
|
||||
" eval $content;"
|
||||
" if ($@)"
|
||||
" {"
|
||||
" weechat::print \"Perl error: unable to load script '$filename':\", \"\";"
|
||||
" weechat::print \"$@\";"
|
||||
" return 2;"
|
||||
" }"
|
||||
" return 0;"
|
||||
"}"
|
||||
"$SIG{__WARN__} = sub { weechat::print \"$_[0]\", \"\"; };"
|
||||
};
|
||||
|
||||
perl_plugin = plugin;
|
||||
|
||||
plugin->printf_server (plugin, "Loading Perl module \"weechat\"");
|
||||
|
||||
my_perl = perl_alloc ();
|
||||
if (!my_perl)
|
||||
{
|
||||
plugin->printf_server (plugin,
|
||||
"Perl error: unable to initialize Perl");
|
||||
return 0;
|
||||
}
|
||||
perl_construct (my_perl);
|
||||
perl_parse (my_perl, weechat_perl_xs_init, 3, perl_args, NULL);
|
||||
eval_pv (weechat_perl_func, TRUE);
|
||||
|
||||
plugin->cmd_handler_add (plugin, "perl",
|
||||
"list/load/unload Perl scripts",
|
||||
"[load filename] | [autoload] | [reload] | [unload]",
|
||||
"filename: Perl script (file) to load\n\n"
|
||||
"Without argument, /perl command lists all loaded Perl scripts.",
|
||||
weechat_perl_cmd, NULL, NULL);
|
||||
|
||||
plugin->mkdir_home (plugin, "perl");
|
||||
plugin->mkdir_home (plugin, "perl/autoload");
|
||||
|
||||
weechat_script_auto_load (plugin, "perl", weechat_perl_load);
|
||||
|
||||
/* init ok */
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* weechat_plugin_end: shutdown Perl interface
|
||||
*/
|
||||
|
||||
void
|
||||
weechat_plugin_end (t_weechat_plugin *plugin)
|
||||
{
|
||||
/* unload all scripts */
|
||||
weechat_perl_unload_all (plugin);
|
||||
|
||||
/* free Perl interpreter */
|
||||
if (my_perl)
|
||||
{
|
||||
perl_destruct (my_perl);
|
||||
perl_free (my_perl);
|
||||
my_perl = NULL;
|
||||
}
|
||||
|
||||
perl_plugin->printf_server (perl_plugin,
|
||||
"Perl plugin ended");
|
||||
}
|
||||
Reference in New Issue
Block a user