diff options
| -rw-r--r-- | src/plugins/perl/Makefile.am | 23 | ||||
| -rw-r--r-- | src/plugins/perl/wee-perl.c | 1065 | ||||
| -rw-r--r-- | src/plugins/perl/wee-perl.h | 34 | ||||
| -rw-r--r-- | weechat/src/plugins/perl/Makefile.am | 23 | ||||
| -rw-r--r-- | weechat/src/plugins/perl/wee-perl.c | 1065 | ||||
| -rw-r--r-- | weechat/src/plugins/perl/wee-perl.h | 34 |
6 files changed, 0 insertions, 2244 deletions
diff --git a/src/plugins/perl/Makefile.am b/src/plugins/perl/Makefile.am deleted file mode 100644 index 11a602c38..000000000 --- a/src/plugins/perl/Makefile.am +++ /dev/null @@ -1,23 +0,0 @@ -# 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) - -noinst_LIBRARIES = lib_weechat_perl.a - -lib_weechat_perl_a_SOURCES = wee-perl.h \ - wee-perl.c diff --git a/src/plugins/perl/wee-perl.c b/src/plugins/perl/wee-perl.c deleted file mode 100644 index 010f72273..000000000 --- a/src/plugins/perl/wee-perl.c +++ /dev/null @@ -1,1065 +0,0 @@ -/* - * 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 - */ - -/* 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> -#undef _ -#include "../../common/weechat.h" -#include "../plugins.h" -#include "wee-perl.h" -#include "../../common/command.h" -#include "../../irc/irc.h" -#include "../../gui/gui.h" - - -static PerlInterpreter *my_perl = NULL; - -t_plugin_script *perl_scripts = NULL; -t_plugin_script *last_perl_script = NULL; - -extern void boot_DynaLoader (pTHX_ CV* cv); - - -/******************************* Old interface ********************************/ - -/* - * IRC::register: startup function for all WeeChat Perl scripts - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_register) -{ - char *name, *version, *shutdown_func, *description; - int integer; - t_plugin_script *ptr_perl_script, *perl_script_found, *new_perl_script; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - version = SvPV (ST (1), integer); - shutdown_func = SvPV (ST (2), integer); - description = SvPV (ST (3), integer); - - perl_script_found = NULL; - for (ptr_perl_script = perl_scripts; ptr_perl_script; - ptr_perl_script = ptr_perl_script->next_script) - { - if (ascii_strcasecmp (ptr_perl_script->name, name) == 0) - { - perl_script_found = ptr_perl_script; - break; - } - } - - if (perl_script_found) - { - /* error: another script already exists with this name! */ - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to register \"%s\" script (another script " - "already exists with this name)\n"), - "Perl", name); - } - else - { - /* registering script */ - new_perl_script = (t_plugin_script *)malloc (sizeof (t_plugin_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); - - /* add new script to list */ - new_perl_script->prev_script = last_perl_script; - new_perl_script->next_script = NULL; - if (perl_scripts) - last_perl_script->next_script = new_perl_script; - else - perl_scripts = new_perl_script; - last_perl_script = new_perl_script; - - wee_log_printf (_("Registered %s script: \"%s\", version %s (%s)\n"), - "Perl", name, version, description); - } - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to load script \"%s\" (not enough memory)\n"), - "Perl", name); - } - } - XST_mPV (0, VERSION); - XSRETURN (1); -} - -/* - * IRC::print: print message to current buffer - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print) -{ - int i, integer; - char *message; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - for (i = 0; i < items; i++) - { - message = SvPV (ST (i), integer); - irc_display_prefix (gui_current_window->buffer, PREFIX_PLUGIN); - gui_printf (gui_current_window->buffer, "%s", message); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::print_with_channel: print message to a specific channel/server - * (server is optional) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print_with_channel) -{ - int integer; - char *message, *channel, *server = NULL; - t_gui_buffer *ptr_buffer; - t_irc_server *ptr_server; - t_irc_channel *ptr_channel; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - /* server specified */ - if (items > 2) - { - server = SvPV (ST (2), integer); - if (!server[0]) - server = NULL; - } - - /* look for buffer for printing message */ - channel = SvPV (ST (1), integer); - ptr_buffer = NULL; - for (ptr_server = irc_servers; ptr_server; - ptr_server = ptr_server->next_server) - { - if (!server || (ascii_strcasecmp (ptr_server->name, server)) == 0) - { - for (ptr_channel = ptr_server->channels; ptr_channel; - ptr_channel = ptr_channel->next_channel) - { - if (ascii_strcasecmp (ptr_channel->name, channel) == 0) - { - ptr_buffer = ptr_channel->buffer; - break; - } - } - } - if (ptr_buffer) - break; - } - - /* buffer found => display message & return 1 */ - if (ptr_buffer) - { - message = SvPV (ST (0), integer); - irc_display_prefix (ptr_buffer, PREFIX_PLUGIN); - gui_printf (ptr_buffer, "%s", message); - XSRETURN_YES; - } - - /* no buffer found => return 0 */ - XSRETURN_NO; -} - -/* - * IRC::print_infobar: print message to infobar - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print_infobar) -{ - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - gui_infobar_printf (SvIV (ST (0)), COLOR_WIN_INFOBAR, SvPV (ST (1), integer)); - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print_infobar"); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::command: send command to server - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_command) -{ - int integer; - char *server, *command, *command2; - t_irc_server *ptr_server; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - { - server = SvPV (ST (0), integer); - command = SvPV (ST (1), integer); - for (ptr_server = irc_servers; ptr_server; ptr_server = ptr_server->next_server) - { - if (ascii_strcasecmp (ptr_server->name, server) == 0) - break; - } - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "command"); - } - } - else - { - ptr_server = SERVER(gui_current_window->buffer); - command = SvPV (ST (0), integer); - } - - if (ptr_server) - { - command2 = (char *) malloc (strlen (command) + 8); - strcpy (command2, command); - if (!strstr (command2, "\r\n")) - strcat (command2, "\r\n"); - server_sendf (ptr_server, command2); - free (command2); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::add_message_handler: add handler for messages (privmsg, ...) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_add_message_handler) -{ - char *name, *function; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - plugin_handler_add (&plugin_msg_handlers, &last_plugin_msg_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_EMPTY; -} - -/* - * IRC::add_command_handler: add command handler (define/redefine commands) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_add_command_handler) -{ - char *name, *function; - int integer; - t_plugin_handler *ptr_plugin_handler; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - if (!weelist_search (index_commands, name)) - weelist_add (&index_commands, &last_index_command, name); - ptr_plugin_handler = plugin_handler_search (plugin_cmd_handlers, name); - if (ptr_plugin_handler) - { - free (ptr_plugin_handler->function_name); - ptr_plugin_handler->function_name = strdup (function); - } - else - plugin_handler_add (&plugin_cmd_handlers, &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_EMPTY; -} - -/* - * IRC::get_info: get various infos - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_get_info) -{ - char *arg, *info = NULL, *server_name; - t_irc_server *ptr_server; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - { - server_name = SvPV (ST (0), integer); - arg = SvPV (ST (1), integer); - ptr_server = server_search (server_name); - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "get_info"); - } - } - else - { - ptr_server = SERVER(gui_current_window->buffer); - arg = SvPV (ST (0), integer); - } - - if (arg) - { - if ( (ascii_strcasecmp (arg, "0") == 0) || (ascii_strcasecmp (arg, "version") == 0) ) - { - info = PACKAGE_STRING; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "1") == 0) || (ascii_strcasecmp (arg, "nick") == 0) ) ) - { - if (ptr_server->nick) - info = ptr_server->nick; - } - else if ( (ascii_strcasecmp (arg, "2") == 0) || (ascii_strcasecmp (arg, "channel") == 0) ) - { - if (BUFFER_IS_CHANNEL (gui_current_window->buffer)) - info = CHANNEL (gui_current_window->buffer)->name; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "3") == 0) || (ascii_strcasecmp (arg, "server") == 0) ) ) - { - if (ptr_server->name) - info = ptr_server->name; - } - else if ( (ascii_strcasecmp (arg, "4") == 0) || (ascii_strcasecmp (arg, "weechatdir") == 0) ) - { - info = weechat_home; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "5") == 0) || (ascii_strcasecmp (arg, "away") == 0) ) ) - { - XST_mIV (0, SERVER(gui_current_window->buffer)->is_away); - XSRETURN (1); - return; - } - - if (info) - XST_mPV (0, info); - else - XST_mPV (0, ""); - } - - XSRETURN (1); -} - -/******************************* New interface ********************************/ - -/* - * weechat::register: startup function for all WeeChat Perl scripts - */ - -static XS (XS_weechat_register) -{ - char *name, *version, *shutdown_func, *description; - int integer; - t_plugin_script *ptr_perl_script, *perl_script_found, *new_perl_script; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - version = SvPV (ST (1), integer); - shutdown_func = SvPV (ST (2), integer); - description = SvPV (ST (3), integer); - - perl_script_found = NULL; - for (ptr_perl_script = perl_scripts; ptr_perl_script; - ptr_perl_script = ptr_perl_script->next_script) - { - if (ascii_strcasecmp (ptr_perl_script->name, name) == 0) - { - perl_script_found = ptr_perl_script; - break; - } - } - - if (perl_script_found) - { - /* error: another script already exists with this name! */ - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to register \"%s\" script (another script " - "already exists with this name)\n"), - "Perl", name); - } - else - { - /* registering script */ - new_perl_script = (t_plugin_script *)malloc (sizeof (t_plugin_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); - - /* add new script to list */ - new_perl_script->prev_script = last_perl_script; - new_perl_script->next_script = NULL; - if (perl_scripts) - last_perl_script->next_script = new_perl_script; - else - perl_scripts = new_perl_script; - last_perl_script = new_perl_script; - - wee_log_printf (_("Registered %s script: \"%s\", version %s (%s)\n"), - "Perl", name, version, description); - } - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to load script \"%s\" (not enough memory)\n"), - "Perl", name); - } - } - XST_mPV (0, VERSION); - XSRETURN (1); -} - -/* - * weechat::print: print message into a buffer (current or specified one) - */ - -static XS (XS_weechat_print) -{ - int integer; - char *message, *channel_name, *server_name; - t_gui_buffer *ptr_buffer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 3)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print"); - 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); - } - - ptr_buffer = plugin_find_buffer (server_name, channel_name); - if (ptr_buffer) - { - message = SvPV (ST (0), integer); - irc_display_prefix (ptr_buffer, PREFIX_PLUGIN); - gui_printf (ptr_buffer, "%s%s", - message, - ((strlen (message) == 0) || (message[strlen (message) - 1] != '\n')) ? "\n" : ""); - - XSRETURN_YES; - } - - /* buffer not found */ - XSRETURN_NO; -} - -/* - * weechat::print_infobar: print message to infobar - */ - -static XS (XS_weechat_print_infobar) -{ - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print_infobar"); - XSRETURN_NO; - } - - gui_infobar_printf (SvIV (ST (0)), COLOR_WIN_INFOBAR, SvPV (ST (1), integer)); - XSRETURN_YES; -} - -/* - * weechat::command: send command to server - */ - -static XS (XS_weechat_command) -{ - int integer; - char *command, *channel_name, *server_name; - t_gui_buffer *ptr_buffer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 3)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "command"); - 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); - } - - ptr_buffer = plugin_find_buffer (server_name, channel_name); - if (ptr_buffer) - { - command = SvPV (ST (0), integer); - user_command (SERVER(ptr_buffer), ptr_buffer, command); - XSRETURN_YES; - } - - /* buffer not found */ - XSRETURN_NO; -} - -/* - * weechat::add_message_handler: add handler for messages (privmsg, ...) - */ - -static XS (XS_weechat_add_message_handler) -{ - char *name, *function; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "add_message_handler"); - XSRETURN_NO; - } - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - plugin_handler_add (&plugin_msg_handlers, &last_plugin_msg_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_YES; -} - -/* - * weechat::add_command_handler: add command handler (define/redefine commands) - */ - -static XS (XS_weechat_add_command_handler) -{ - char *name, *function; - int integer; - t_plugin_handler *ptr_plugin_handler; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "add_command_handler"); - XSRETURN_NO; - } - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - if (!weelist_search (index_commands, name)) - weelist_add (&index_commands, &last_index_command, name); - ptr_plugin_handler = plugin_handler_search (plugin_cmd_handlers, name); - if (ptr_plugin_handler) - { - free (ptr_plugin_handler->function_name); - ptr_plugin_handler->function_name = strdup (function); - } - else - plugin_handler_add (&plugin_cmd_handlers, &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL, name, function); - - XSRETURN_YES; -} - -/* - * weechat::get_info: get various infos - */ - -static XS (XS_weechat_get_info) -{ - char *arg, *info = NULL, *server_name; - t_irc_server *ptr_server; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 2)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "get_info"); - XSRETURN_NO; - } - - if (items == 2) - { - server_name = SvPV (ST (1), integer); - ptr_server = server_search (server_name); - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "get_info"); - XSRETURN_NO; - } - } - else - ptr_server = SERVER(gui_current_window->buffer); - - arg = SvPV (ST (0), integer); - if (arg) - { - if ( (ascii_strcasecmp (arg, "0") == 0) || (ascii_strcasecmp (arg, "version") == 0) ) - { - info = PACKAGE_STRING; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "1") == 0) || (ascii_strcasecmp (arg, "nick") == 0) ) ) - { - if (ptr_server->nick) - info = ptr_server->nick; - } - else if ( (ascii_strcasecmp (arg, "2") == 0) || (ascii_strcasecmp (arg, "channel") == 0) ) - { - if (BUFFER_IS_CHANNEL (gui_current_window->buffer)) - info = CHANNEL (gui_current_window->buffer)->name; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "3") == 0) || (ascii_strcasecmp (arg, "server") == 0) ) ) - { - if (ptr_server->name) - info = ptr_server->name; - } - else if ( (ascii_strcasecmp (arg, "4") == 0) || (ascii_strcasecmp (arg, "weechatdir") == 0) ) - { - info = weechat_home; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "5") == 0) || (ascii_strcasecmp (arg, "away") == 0) ) ) - { - XST_mIV (0, SERVER(gui_current_window->buffer)->is_away); - XSRETURN (1); - return; - } - else if ( (ascii_strcasecmp (arg, "100") == 0) || (ascii_strcasecmp (arg, "dccs") == 0) ) - { - int nItems = 0; - t_irc_dcc *p = dcc_list; - - POPs; - if (items == 2) - POPs; - - for(; p; p = p->next_dcc) - { - HV *infohash = (HV *) sv_2mortal((SV *) newHV()); - hv_store (infohash, "address32", 9, newSViv(p->addr), 0); - hv_store (infohash, "cps", 3, newSViv(p->bytes_per_sec), 0); - hv_store (infohash, "remote_file", 11, newSVpv(p->filename, 0), 0); - hv_store (infohash, "local_file", 10, newSVpv(p->local_filename, 0), 0); - hv_store (infohash, "nick", 4, newSVpv(p->nick, 0), 0); - hv_store (infohash, "port", 4, newSViv(p->port), 0); - hv_store (infohash, "pos", 3, newSVnv(p->pos), 0); - hv_store (infohash, "size", 4, newSVnv(p->size), 0); - hv_store (infohash, "status", 6, newSViv(p->status), 0); - hv_store (infohash, "type", 4, newSViv(p->type), 0); - - XPUSHs(newRV((SV *) infohash)); - ++nItems; - } - XSRETURN(nItems); - return; - } - - if (info) - XST_mPV (0, info); - else - XST_mPV (0, ""); - } - - XSRETURN (1); -} - -/* - * xs_init: initialize subroutines - */ - -void -xs_init (pTHX) -{ - newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); - - /* DEPRECATED & old interface (WeeChat <= 0.1.1), kept for compatibility */ - newXS ("IRC::register", XS_IRC_register, "IRC"); - newXS ("IRC::print", XS_IRC_print, "IRC"); - newXS ("IRC::print_with_channel", XS_IRC_print_with_channel, "IRC"); - newXS ("IRC::print_infobar", XS_IRC_print_infobar, "IRC"); - newXS ("IRC::command", XS_IRC_command, "IRC"); - newXS ("IRC::add_message_handler", XS_IRC_add_message_handler, "IRC"); - newXS ("IRC::add_command_handler", XS_IRC_add_command_handler, "IRC"); - newXS ("IRC::get_info", XS_IRC_get_info, "IRC"); - - /* new interface (WeeChat >= 0.1.2) */ - 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"); -} - -/* - * wee_perl_init: initialize Perl interface for WeeChat - */ - -void -wee_perl_init () -{ - 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 \"WeeChat Error: Perl script '$filename' not found.\\n\", \"\";" - " return 1;" - " }" - " eval $content;" - " if ($@)" - " {" - " weechat::print \"WeeChat error: unable to load Perl script '$filename':\\n\", \"\";" - " weechat::print \"$@\\n\";" - " return 2;" - " }" - " return 0;" - "}" - "$SIG{__WARN__} = sub { weechat::print \"$_[0]\n\", \"\"; };" - }; - - wee_log_printf (_("Loading %s module \"weechat\"\n"), "Perl"); - 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_plugin_script * -wee_perl_search (char *name) -{ - t_plugin_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 *server, char *arguments) -{ - char *argv[3]; - int count, return_code; - SV *sv; - - /* call Perl function */ - dSP; - ENTER; - SAVETMPS; - PUSHMARK(sp); - if (!server) - argv[0] = strdup (""); - else - argv[0] = server; - argv[1] = arguments; - argv[2] = 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)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("Perl error: %s"), - SvPV (sv, count)); - POPs; - } - else - { - if (count != 1) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: too much values from \"%s\" (%d). Expected: 1.\n"), - "Perl", 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 %s script \"%s\"\n"), "Perl", filename); - irc_display_prefix (NULL, PREFIX_PLUGIN); - gui_printf (NULL, _("Loading %s script \"%s\"\n"), "Perl", filename); - return wee_perl_exec ("wee_perl_load_eval_file", filename, ""); -} - -/* - * wee_perl_script_free: free a Perl script - */ - -void -wee_perl_script_free (t_plugin_script *ptr_perl_script) -{ - t_plugin_script *new_perl_scripts; - - /* remove script from list */ - if (last_perl_script == ptr_perl_script) - last_perl_script = ptr_perl_script->prev_script; - if (ptr_perl_script->prev_script) - { - (ptr_perl_script->prev_script)->next_script = ptr_perl_script->next_script; - new_perl_scripts = perl_scripts; - } - else - new_perl_scripts = ptr_perl_script->next_script; - - if (ptr_perl_script->next_script) - (ptr_perl_script->next_script)->prev_script = ptr_perl_script->prev_script; - - /* 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); - free (ptr_perl_script); - perl_scripts = new_perl_scripts; -} - -/* - * wee_perl_unload: unload a Perl script - */ - -void -wee_perl_unload (t_plugin_script *ptr_perl_script) -{ - if (ptr_perl_script) - { - wee_log_printf (_("Unloading %s script \"%s\"\n"), - "Perl", ptr_perl_script->name); - - /* call shutdown callback function */ - if (ptr_perl_script->shutdown_func[0]) - wee_perl_exec (ptr_perl_script->shutdown_func, "", ""); - wee_perl_script_free (ptr_perl_script); - } -} - -/* - * wee_perl_unload_all: unload all Perl scripts - */ - -void -wee_perl_unload_all () -{ - wee_log_printf (_("Unloading all %s scripts...\n"), "Perl"); - while (perl_scripts) - wee_perl_unload (perl_scripts); - - irc_display_prefix (NULL, PREFIX_PLUGIN); - gui_printf (NULL, _("%s scripts unloaded\n"), "Perl"); -} - -/* - * wee_perl_end: shutdown Perl interface - */ - -void -wee_perl_end () -{ - /* unload all scripts */ - wee_perl_unload_all (); - - /* free all handlers */ - plugin_handler_free_all_type (&plugin_msg_handlers, - &last_plugin_msg_handler, - PLUGIN_TYPE_PERL); - plugin_handler_free_all_type (&plugin_cmd_handlers, - &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL); - - /* free Perl interpreter */ - if (my_perl) - { - perl_destruct (my_perl); - perl_free (my_perl); - my_perl = NULL; - } -} diff --git a/src/plugins/perl/wee-perl.h b/src/plugins/perl/wee-perl.h deleted file mode 100644 index a7177bb65..000000000 --- a/src/plugins/perl/wee-perl.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * 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 - */ - - -#ifndef __WEECHAT_PERL_H -#define __WEECHAT_PERL_H 1 - -#include "../plugins.h" - -extern void wee_perl_init (); -extern t_plugin_script *wee_perl_search (char *); -extern int wee_perl_exec (char *, char *, char *); -extern int wee_perl_load (char *); -extern void wee_perl_unload (t_plugin_script *); -extern void wee_perl_unload_all (); -extern void wee_perl_end (); - -#endif /* wee-perl.h */ diff --git a/weechat/src/plugins/perl/Makefile.am b/weechat/src/plugins/perl/Makefile.am deleted file mode 100644 index 11a602c38..000000000 --- a/weechat/src/plugins/perl/Makefile.am +++ /dev/null @@ -1,23 +0,0 @@ -# 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) - -noinst_LIBRARIES = lib_weechat_perl.a - -lib_weechat_perl_a_SOURCES = wee-perl.h \ - wee-perl.c diff --git a/weechat/src/plugins/perl/wee-perl.c b/weechat/src/plugins/perl/wee-perl.c deleted file mode 100644 index 010f72273..000000000 --- a/weechat/src/plugins/perl/wee-perl.c +++ /dev/null @@ -1,1065 +0,0 @@ -/* - * 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 - */ - -/* 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> -#undef _ -#include "../../common/weechat.h" -#include "../plugins.h" -#include "wee-perl.h" -#include "../../common/command.h" -#include "../../irc/irc.h" -#include "../../gui/gui.h" - - -static PerlInterpreter *my_perl = NULL; - -t_plugin_script *perl_scripts = NULL; -t_plugin_script *last_perl_script = NULL; - -extern void boot_DynaLoader (pTHX_ CV* cv); - - -/******************************* Old interface ********************************/ - -/* - * IRC::register: startup function for all WeeChat Perl scripts - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_register) -{ - char *name, *version, *shutdown_func, *description; - int integer; - t_plugin_script *ptr_perl_script, *perl_script_found, *new_perl_script; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - version = SvPV (ST (1), integer); - shutdown_func = SvPV (ST (2), integer); - description = SvPV (ST (3), integer); - - perl_script_found = NULL; - for (ptr_perl_script = perl_scripts; ptr_perl_script; - ptr_perl_script = ptr_perl_script->next_script) - { - if (ascii_strcasecmp (ptr_perl_script->name, name) == 0) - { - perl_script_found = ptr_perl_script; - break; - } - } - - if (perl_script_found) - { - /* error: another script already exists with this name! */ - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to register \"%s\" script (another script " - "already exists with this name)\n"), - "Perl", name); - } - else - { - /* registering script */ - new_perl_script = (t_plugin_script *)malloc (sizeof (t_plugin_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); - - /* add new script to list */ - new_perl_script->prev_script = last_perl_script; - new_perl_script->next_script = NULL; - if (perl_scripts) - last_perl_script->next_script = new_perl_script; - else - perl_scripts = new_perl_script; - last_perl_script = new_perl_script; - - wee_log_printf (_("Registered %s script: \"%s\", version %s (%s)\n"), - "Perl", name, version, description); - } - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to load script \"%s\" (not enough memory)\n"), - "Perl", name); - } - } - XST_mPV (0, VERSION); - XSRETURN (1); -} - -/* - * IRC::print: print message to current buffer - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print) -{ - int i, integer; - char *message; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - for (i = 0; i < items; i++) - { - message = SvPV (ST (i), integer); - irc_display_prefix (gui_current_window->buffer, PREFIX_PLUGIN); - gui_printf (gui_current_window->buffer, "%s", message); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::print_with_channel: print message to a specific channel/server - * (server is optional) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print_with_channel) -{ - int integer; - char *message, *channel, *server = NULL; - t_gui_buffer *ptr_buffer; - t_irc_server *ptr_server; - t_irc_channel *ptr_channel; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - /* server specified */ - if (items > 2) - { - server = SvPV (ST (2), integer); - if (!server[0]) - server = NULL; - } - - /* look for buffer for printing message */ - channel = SvPV (ST (1), integer); - ptr_buffer = NULL; - for (ptr_server = irc_servers; ptr_server; - ptr_server = ptr_server->next_server) - { - if (!server || (ascii_strcasecmp (ptr_server->name, server)) == 0) - { - for (ptr_channel = ptr_server->channels; ptr_channel; - ptr_channel = ptr_channel->next_channel) - { - if (ascii_strcasecmp (ptr_channel->name, channel) == 0) - { - ptr_buffer = ptr_channel->buffer; - break; - } - } - } - if (ptr_buffer) - break; - } - - /* buffer found => display message & return 1 */ - if (ptr_buffer) - { - message = SvPV (ST (0), integer); - irc_display_prefix (ptr_buffer, PREFIX_PLUGIN); - gui_printf (ptr_buffer, "%s", message); - XSRETURN_YES; - } - - /* no buffer found => return 0 */ - XSRETURN_NO; -} - -/* - * IRC::print_infobar: print message to infobar - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_print_infobar) -{ - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - gui_infobar_printf (SvIV (ST (0)), COLOR_WIN_INFOBAR, SvPV (ST (1), integer)); - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print_infobar"); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::command: send command to server - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_command) -{ - int integer; - char *server, *command, *command2; - t_irc_server *ptr_server; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - { - server = SvPV (ST (0), integer); - command = SvPV (ST (1), integer); - for (ptr_server = irc_servers; ptr_server; ptr_server = ptr_server->next_server) - { - if (ascii_strcasecmp (ptr_server->name, server) == 0) - break; - } - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "command"); - } - } - else - { - ptr_server = SERVER(gui_current_window->buffer); - command = SvPV (ST (0), integer); - } - - if (ptr_server) - { - command2 = (char *) malloc (strlen (command) + 8); - strcpy (command2, command); - if (!strstr (command2, "\r\n")) - strcat (command2, "\r\n"); - server_sendf (ptr_server, command2); - free (command2); - } - - XSRETURN_EMPTY; -} - -/* - * IRC::add_message_handler: add handler for messages (privmsg, ...) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_add_message_handler) -{ - char *name, *function; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - plugin_handler_add (&plugin_msg_handlers, &last_plugin_msg_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_EMPTY; -} - -/* - * IRC::add_command_handler: add command handler (define/redefine commands) - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_add_command_handler) -{ - char *name, *function; - int integer; - t_plugin_handler *ptr_plugin_handler; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - if (!weelist_search (index_commands, name)) - weelist_add (&index_commands, &last_index_command, name); - ptr_plugin_handler = plugin_handler_search (plugin_cmd_handlers, name); - if (ptr_plugin_handler) - { - free (ptr_plugin_handler->function_name); - ptr_plugin_handler->function_name = strdup (function); - } - else - plugin_handler_add (&plugin_cmd_handlers, &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_EMPTY; -} - -/* - * IRC::get_info: get various infos - */ - -/*** DEPRECATED function, kept for compatibility only, please don't update! ***/ - -static XS (XS_IRC_get_info) -{ - char *arg, *info = NULL, *server_name; - t_irc_server *ptr_server; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items == 2) - { - server_name = SvPV (ST (0), integer); - arg = SvPV (ST (1), integer); - ptr_server = server_search (server_name); - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "get_info"); - } - } - else - { - ptr_server = SERVER(gui_current_window->buffer); - arg = SvPV (ST (0), integer); - } - - if (arg) - { - if ( (ascii_strcasecmp (arg, "0") == 0) || (ascii_strcasecmp (arg, "version") == 0) ) - { - info = PACKAGE_STRING; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "1") == 0) || (ascii_strcasecmp (arg, "nick") == 0) ) ) - { - if (ptr_server->nick) - info = ptr_server->nick; - } - else if ( (ascii_strcasecmp (arg, "2") == 0) || (ascii_strcasecmp (arg, "channel") == 0) ) - { - if (BUFFER_IS_CHANNEL (gui_current_window->buffer)) - info = CHANNEL (gui_current_window->buffer)->name; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "3") == 0) || (ascii_strcasecmp (arg, "server") == 0) ) ) - { - if (ptr_server->name) - info = ptr_server->name; - } - else if ( (ascii_strcasecmp (arg, "4") == 0) || (ascii_strcasecmp (arg, "weechatdir") == 0) ) - { - info = weechat_home; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "5") == 0) || (ascii_strcasecmp (arg, "away") == 0) ) ) - { - XST_mIV (0, SERVER(gui_current_window->buffer)->is_away); - XSRETURN (1); - return; - } - - if (info) - XST_mPV (0, info); - else - XST_mPV (0, ""); - } - - XSRETURN (1); -} - -/******************************* New interface ********************************/ - -/* - * weechat::register: startup function for all WeeChat Perl scripts - */ - -static XS (XS_weechat_register) -{ - char *name, *version, *shutdown_func, *description; - int integer; - t_plugin_script *ptr_perl_script, *perl_script_found, *new_perl_script; - dXSARGS; - - /* make gcc happy */ - (void) items; - (void) cv; - - name = SvPV (ST (0), integer); - version = SvPV (ST (1), integer); - shutdown_func = SvPV (ST (2), integer); - description = SvPV (ST (3), integer); - - perl_script_found = NULL; - for (ptr_perl_script = perl_scripts; ptr_perl_script; - ptr_perl_script = ptr_perl_script->next_script) - { - if (ascii_strcasecmp (ptr_perl_script->name, name) == 0) - { - perl_script_found = ptr_perl_script; - break; - } - } - - if (perl_script_found) - { - /* error: another script already exists with this name! */ - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to register \"%s\" script (another script " - "already exists with this name)\n"), - "Perl", name); - } - else - { - /* registering script */ - new_perl_script = (t_plugin_script *)malloc (sizeof (t_plugin_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); - - /* add new script to list */ - new_perl_script->prev_script = last_perl_script; - new_perl_script->next_script = NULL; - if (perl_scripts) - last_perl_script->next_script = new_perl_script; - else - perl_scripts = new_perl_script; - last_perl_script = new_perl_script; - - wee_log_printf (_("Registered %s script: \"%s\", version %s (%s)\n"), - "Perl", name, version, description); - } - else - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: unable to load script \"%s\" (not enough memory)\n"), - "Perl", name); - } - } - XST_mPV (0, VERSION); - XSRETURN (1); -} - -/* - * weechat::print: print message into a buffer (current or specified one) - */ - -static XS (XS_weechat_print) -{ - int integer; - char *message, *channel_name, *server_name; - t_gui_buffer *ptr_buffer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 3)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print"); - 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); - } - - ptr_buffer = plugin_find_buffer (server_name, channel_name); - if (ptr_buffer) - { - message = SvPV (ST (0), integer); - irc_display_prefix (ptr_buffer, PREFIX_PLUGIN); - gui_printf (ptr_buffer, "%s%s", - message, - ((strlen (message) == 0) || (message[strlen (message) - 1] != '\n')) ? "\n" : ""); - - XSRETURN_YES; - } - - /* buffer not found */ - XSRETURN_NO; -} - -/* - * weechat::print_infobar: print message to infobar - */ - -static XS (XS_weechat_print_infobar) -{ - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "print_infobar"); - XSRETURN_NO; - } - - gui_infobar_printf (SvIV (ST (0)), COLOR_WIN_INFOBAR, SvPV (ST (1), integer)); - XSRETURN_YES; -} - -/* - * weechat::command: send command to server - */ - -static XS (XS_weechat_command) -{ - int integer; - char *command, *channel_name, *server_name; - t_gui_buffer *ptr_buffer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 3)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "command"); - 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); - } - - ptr_buffer = plugin_find_buffer (server_name, channel_name); - if (ptr_buffer) - { - command = SvPV (ST (0), integer); - user_command (SERVER(ptr_buffer), ptr_buffer, command); - XSRETURN_YES; - } - - /* buffer not found */ - XSRETURN_NO; -} - -/* - * weechat::add_message_handler: add handler for messages (privmsg, ...) - */ - -static XS (XS_weechat_add_message_handler) -{ - char *name, *function; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "add_message_handler"); - XSRETURN_NO; - } - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - plugin_handler_add (&plugin_msg_handlers, &last_plugin_msg_handler, - PLUGIN_TYPE_PERL, name, function); - XSRETURN_YES; -} - -/* - * weechat::add_command_handler: add command handler (define/redefine commands) - */ - -static XS (XS_weechat_add_command_handler) -{ - char *name, *function; - int integer; - t_plugin_handler *ptr_plugin_handler; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if (items != 2) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "add_command_handler"); - XSRETURN_NO; - } - - name = SvPV (ST (0), integer); - function = SvPV (ST (1), integer); - if (!weelist_search (index_commands, name)) - weelist_add (&index_commands, &last_index_command, name); - ptr_plugin_handler = plugin_handler_search (plugin_cmd_handlers, name); - if (ptr_plugin_handler) - { - free (ptr_plugin_handler->function_name); - ptr_plugin_handler->function_name = strdup (function); - } - else - plugin_handler_add (&plugin_cmd_handlers, &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL, name, function); - - XSRETURN_YES; -} - -/* - * weechat::get_info: get various infos - */ - -static XS (XS_weechat_get_info) -{ - char *arg, *info = NULL, *server_name; - t_irc_server *ptr_server; - int integer; - dXSARGS; - - /* make gcc happy */ - (void) cv; - - if ((items < 1) || (items > 2)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: wrong parameters for \"%s\" function\n"), - "Perl", "get_info"); - XSRETURN_NO; - } - - if (items == 2) - { - server_name = SvPV (ST (1), integer); - ptr_server = server_search (server_name); - if (!ptr_server) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: server not found for \"%s\" function\n"), - "Perl", "get_info"); - XSRETURN_NO; - } - } - else - ptr_server = SERVER(gui_current_window->buffer); - - arg = SvPV (ST (0), integer); - if (arg) - { - if ( (ascii_strcasecmp (arg, "0") == 0) || (ascii_strcasecmp (arg, "version") == 0) ) - { - info = PACKAGE_STRING; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "1") == 0) || (ascii_strcasecmp (arg, "nick") == 0) ) ) - { - if (ptr_server->nick) - info = ptr_server->nick; - } - else if ( (ascii_strcasecmp (arg, "2") == 0) || (ascii_strcasecmp (arg, "channel") == 0) ) - { - if (BUFFER_IS_CHANNEL (gui_current_window->buffer)) - info = CHANNEL (gui_current_window->buffer)->name; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "3") == 0) || (ascii_strcasecmp (arg, "server") == 0) ) ) - { - if (ptr_server->name) - info = ptr_server->name; - } - else if ( (ascii_strcasecmp (arg, "4") == 0) || (ascii_strcasecmp (arg, "weechatdir") == 0) ) - { - info = weechat_home; - } - else if ( ptr_server && ( (ascii_strcasecmp (arg, "5") == 0) || (ascii_strcasecmp (arg, "away") == 0) ) ) - { - XST_mIV (0, SERVER(gui_current_window->buffer)->is_away); - XSRETURN (1); - return; - } - else if ( (ascii_strcasecmp (arg, "100") == 0) || (ascii_strcasecmp (arg, "dccs") == 0) ) - { - int nItems = 0; - t_irc_dcc *p = dcc_list; - - POPs; - if (items == 2) - POPs; - - for(; p; p = p->next_dcc) - { - HV *infohash = (HV *) sv_2mortal((SV *) newHV()); - hv_store (infohash, "address32", 9, newSViv(p->addr), 0); - hv_store (infohash, "cps", 3, newSViv(p->bytes_per_sec), 0); - hv_store (infohash, "remote_file", 11, newSVpv(p->filename, 0), 0); - hv_store (infohash, "local_file", 10, newSVpv(p->local_filename, 0), 0); - hv_store (infohash, "nick", 4, newSVpv(p->nick, 0), 0); - hv_store (infohash, "port", 4, newSViv(p->port), 0); - hv_store (infohash, "pos", 3, newSVnv(p->pos), 0); - hv_store (infohash, "size", 4, newSVnv(p->size), 0); - hv_store (infohash, "status", 6, newSViv(p->status), 0); - hv_store (infohash, "type", 4, newSViv(p->type), 0); - - XPUSHs(newRV((SV *) infohash)); - ++nItems; - } - XSRETURN(nItems); - return; - } - - if (info) - XST_mPV (0, info); - else - XST_mPV (0, ""); - } - - XSRETURN (1); -} - -/* - * xs_init: initialize subroutines - */ - -void -xs_init (pTHX) -{ - newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); - - /* DEPRECATED & old interface (WeeChat <= 0.1.1), kept for compatibility */ - newXS ("IRC::register", XS_IRC_register, "IRC"); - newXS ("IRC::print", XS_IRC_print, "IRC"); - newXS ("IRC::print_with_channel", XS_IRC_print_with_channel, "IRC"); - newXS ("IRC::print_infobar", XS_IRC_print_infobar, "IRC"); - newXS ("IRC::command", XS_IRC_command, "IRC"); - newXS ("IRC::add_message_handler", XS_IRC_add_message_handler, "IRC"); - newXS ("IRC::add_command_handler", XS_IRC_add_command_handler, "IRC"); - newXS ("IRC::get_info", XS_IRC_get_info, "IRC"); - - /* new interface (WeeChat >= 0.1.2) */ - 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"); -} - -/* - * wee_perl_init: initialize Perl interface for WeeChat - */ - -void -wee_perl_init () -{ - 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 \"WeeChat Error: Perl script '$filename' not found.\\n\", \"\";" - " return 1;" - " }" - " eval $content;" - " if ($@)" - " {" - " weechat::print \"WeeChat error: unable to load Perl script '$filename':\\n\", \"\";" - " weechat::print \"$@\\n\";" - " return 2;" - " }" - " return 0;" - "}" - "$SIG{__WARN__} = sub { weechat::print \"$_[0]\n\", \"\"; };" - }; - - wee_log_printf (_("Loading %s module \"weechat\"\n"), "Perl"); - 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_plugin_script * -wee_perl_search (char *name) -{ - t_plugin_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 *server, char *arguments) -{ - char *argv[3]; - int count, return_code; - SV *sv; - - /* call Perl function */ - dSP; - ENTER; - SAVETMPS; - PUSHMARK(sp); - if (!server) - argv[0] = strdup (""); - else - argv[0] = server; - argv[1] = arguments; - argv[2] = 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)) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("Perl error: %s"), - SvPV (sv, count)); - POPs; - } - else - { - if (count != 1) - { - irc_display_prefix (NULL, PREFIX_ERROR); - gui_printf (NULL, - _("%s error: too much values from \"%s\" (%d). Expected: 1.\n"), - "Perl", 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 %s script \"%s\"\n"), "Perl", filename); - irc_display_prefix (NULL, PREFIX_PLUGIN); - gui_printf (NULL, _("Loading %s script \"%s\"\n"), "Perl", filename); - return wee_perl_exec ("wee_perl_load_eval_file", filename, ""); -} - -/* - * wee_perl_script_free: free a Perl script - */ - -void -wee_perl_script_free (t_plugin_script *ptr_perl_script) -{ - t_plugin_script *new_perl_scripts; - - /* remove script from list */ - if (last_perl_script == ptr_perl_script) - last_perl_script = ptr_perl_script->prev_script; - if (ptr_perl_script->prev_script) - { - (ptr_perl_script->prev_script)->next_script = ptr_perl_script->next_script; - new_perl_scripts = perl_scripts; - } - else - new_perl_scripts = ptr_perl_script->next_script; - - if (ptr_perl_script->next_script) - (ptr_perl_script->next_script)->prev_script = ptr_perl_script->prev_script; - - /* 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); - free (ptr_perl_script); - perl_scripts = new_perl_scripts; -} - -/* - * wee_perl_unload: unload a Perl script - */ - -void -wee_perl_unload (t_plugin_script *ptr_perl_script) -{ - if (ptr_perl_script) - { - wee_log_printf (_("Unloading %s script \"%s\"\n"), - "Perl", ptr_perl_script->name); - - /* call shutdown callback function */ - if (ptr_perl_script->shutdown_func[0]) - wee_perl_exec (ptr_perl_script->shutdown_func, "", ""); - wee_perl_script_free (ptr_perl_script); - } -} - -/* - * wee_perl_unload_all: unload all Perl scripts - */ - -void -wee_perl_unload_all () -{ - wee_log_printf (_("Unloading all %s scripts...\n"), "Perl"); - while (perl_scripts) - wee_perl_unload (perl_scripts); - - irc_display_prefix (NULL, PREFIX_PLUGIN); - gui_printf (NULL, _("%s scripts unloaded\n"), "Perl"); -} - -/* - * wee_perl_end: shutdown Perl interface - */ - -void -wee_perl_end () -{ - /* unload all scripts */ - wee_perl_unload_all (); - - /* free all handlers */ - plugin_handler_free_all_type (&plugin_msg_handlers, - &last_plugin_msg_handler, - PLUGIN_TYPE_PERL); - plugin_handler_free_all_type (&plugin_cmd_handlers, - &last_plugin_cmd_handler, - PLUGIN_TYPE_PERL); - - /* free Perl interpreter */ - if (my_perl) - { - perl_destruct (my_perl); - perl_free (my_perl); - my_perl = NULL; - } -} diff --git a/weechat/src/plugins/perl/wee-perl.h b/weechat/src/plugins/perl/wee-perl.h deleted file mode 100644 index a7177bb65..000000000 --- a/weechat/src/plugins/perl/wee-perl.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * 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 - */ - - -#ifndef __WEECHAT_PERL_H -#define __WEECHAT_PERL_H 1 - -#include "../plugins.h" - -extern void wee_perl_init (); -extern t_plugin_script *wee_perl_search (char *); -extern int wee_perl_exec (char *, char *, char *); -extern int wee_perl_load (char *); -extern void wee_perl_unload (t_plugin_script *); -extern void wee_perl_unload_all (); -extern void wee_perl_end (); - -#endif /* wee-perl.h */ |