New plugin interface (loads dynamic C libraries)

2 files changed, 765 insertions, 0 deletions

diff --git a/src/plugins/scripts/perl/Makefile.am b/src/plugins/scripts/perl/Makefile.am
new file mode 100644
index 000000000..1327bab98
--- /dev/null
+++ b/src/plugins/scripts/perl/Makefile.am
@@ -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)
diff --git a/src/plugins/scripts/perl/weechat-perl.c b/src/plugins/scripts/perl/weechat-perl.c
new file mode 100644
index 000000000..504a0a596
--- /dev/null
+++ b/src/plugins/scripts/perl/weechat-perl.c
@@ -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");
+}