2001-07-29 05:17:53 -04:00
|
|
|
/*
|
|
|
|
perl-core.c : irssi
|
|
|
|
|
|
|
|
Copyright (C) 1999-2001 Timo Sirainen
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
2007-05-08 14:41:10 -04:00
|
|
|
You should have received a copy of the GNU General Public License along
|
|
|
|
with this program; if not, write to the Free Software Foundation, Inc.,
|
|
|
|
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
2001-07-29 05:17:53 -04:00
|
|
|
*/
|
|
|
|
|
2001-08-13 20:41:59 -04:00
|
|
|
#include "module-fe.h"
|
|
|
|
#include "modules.h"
|
2001-07-29 05:17:53 -04:00
|
|
|
#include "module-formats.h"
|
|
|
|
#include "signals.h"
|
|
|
|
#include "commands.h"
|
|
|
|
#include "levels.h"
|
|
|
|
|
|
|
|
#include "printtext.h"
|
|
|
|
#include "completion.h"
|
|
|
|
|
|
|
|
#include "perl-core.h"
|
|
|
|
|
|
|
|
static void cmd_script(const char *data, SERVER_REC *server, void *item)
|
|
|
|
{
|
2001-10-23 16:49:17 -04:00
|
|
|
if (*data == '\0')
|
|
|
|
data = "list";
|
|
|
|
|
2001-07-29 05:17:53 -04:00
|
|
|
command_runsub("script", data, server, item);
|
|
|
|
}
|
|
|
|
|
|
|
|
static void cmd_script_exec(const char *data)
|
|
|
|
{
|
|
|
|
PERL_SCRIPT_REC *script;
|
|
|
|
GHashTable *optlist;
|
|
|
|
char *code;
|
|
|
|
void *free_arg;
|
|
|
|
|
2001-07-29 09:13:16 -04:00
|
|
|
if (!cmd_get_params(data, &free_arg, 1 | PARAM_FLAG_OPTIONS |
|
|
|
|
PARAM_FLAG_GETREST,
|
2001-07-29 05:17:53 -04:00
|
|
|
"script exec", &optlist, &code))
|
|
|
|
return;
|
|
|
|
|
|
|
|
if (*code == '\0')
|
|
|
|
cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
|
|
|
|
|
|
|
|
script = perl_script_load_data(code);
|
|
|
|
if (script != NULL &&
|
|
|
|
g_hash_table_lookup(optlist, "permanent") == NULL) {
|
|
|
|
/* not a permanent script, unload immediately */
|
|
|
|
perl_script_unload(script);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
cmd_params_free(free_arg);
|
|
|
|
}
|
|
|
|
|
|
|
|
static void cmd_script_load(const char *data)
|
|
|
|
{
|
|
|
|
PERL_SCRIPT_REC *script;
|
2001-07-30 09:06:21 -04:00
|
|
|
char *fname, *path;
|
|
|
|
void *free_arg;
|
|
|
|
|
|
|
|
if (!cmd_get_params(data, &free_arg, 1, &path))
|
|
|
|
return;
|
|
|
|
|
|
|
|
if (*path == '\0')
|
|
|
|
cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
|
2001-07-29 05:17:53 -04:00
|
|
|
|
2001-07-30 09:07:26 -04:00
|
|
|
fname = perl_script_get_path(path);
|
2001-07-29 05:17:53 -04:00
|
|
|
if (fname == NULL) {
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
|
|
|
|
TXT_SCRIPT_NOT_FOUND, data);
|
2001-07-30 09:06:21 -04:00
|
|
|
} else {
|
|
|
|
script = perl_script_load_file(fname);
|
|
|
|
if (script != NULL) {
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
|
|
|
|
TXT_SCRIPT_LOADED,
|
|
|
|
script->name, script->path);
|
|
|
|
}
|
|
|
|
g_free(fname);
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
2001-07-30 09:06:21 -04:00
|
|
|
cmd_params_free(free_arg);
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static void cmd_script_unload(const char *data)
|
|
|
|
{
|
2001-07-30 09:06:21 -04:00
|
|
|
PERL_SCRIPT_REC *script;
|
|
|
|
char *name;
|
|
|
|
void *free_arg;
|
|
|
|
|
|
|
|
if (!cmd_get_params(data, &free_arg, 1, &name))
|
|
|
|
return;
|
|
|
|
|
|
|
|
if (*name == '\0')
|
|
|
|
cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
|
2001-07-29 05:17:53 -04:00
|
|
|
|
2001-11-25 11:17:44 -05:00
|
|
|
script_fix_name(name);
|
2001-07-30 09:07:26 -04:00
|
|
|
script = perl_script_find(name);
|
2001-07-29 05:17:53 -04:00
|
|
|
if (script == NULL) {
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
|
2001-11-25 11:17:44 -05:00
|
|
|
TXT_SCRIPT_NOT_LOADED, name);
|
2001-07-30 09:06:21 -04:00
|
|
|
} else {
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
|
|
|
|
TXT_SCRIPT_UNLOADED, script->name);
|
|
|
|
perl_script_unload(script);
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
2001-07-30 09:06:21 -04:00
|
|
|
cmd_params_free(free_arg);
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
|
|
|
|
2001-07-30 09:06:21 -04:00
|
|
|
static void cmd_script_reset(const char *data)
|
2001-07-29 05:17:53 -04:00
|
|
|
{
|
|
|
|
perl_scripts_deinit();
|
|
|
|
perl_scripts_init();
|
|
|
|
}
|
|
|
|
|
|
|
|
static void cmd_script_list(void)
|
|
|
|
{
|
|
|
|
GSList *tmp;
|
|
|
|
GString *data;
|
|
|
|
|
|
|
|
if (perl_scripts == NULL) {
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
|
|
|
|
TXT_NO_SCRIPTS_LOADED);
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2001-07-29 09:13:16 -04:00
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
|
2001-07-29 05:17:53 -04:00
|
|
|
TXT_SCRIPT_LIST_HEADER);
|
|
|
|
|
|
|
|
data = g_string_new(NULL);
|
|
|
|
for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
|
|
|
|
PERL_SCRIPT_REC *rec = tmp->data;
|
|
|
|
|
|
|
|
if (rec->path != NULL)
|
|
|
|
g_string_assign(data, rec->path);
|
|
|
|
else {
|
|
|
|
g_string_assign(data, rec->data);
|
|
|
|
if (data->len > 50) {
|
|
|
|
g_string_truncate(data, 50);
|
|
|
|
g_string_append(data, " ...");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2001-07-29 09:13:16 -04:00
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
|
2001-07-29 05:17:53 -04:00
|
|
|
TXT_SCRIPT_LIST_LINE, rec->name, data->str);
|
|
|
|
}
|
|
|
|
g_string_free(data, TRUE);
|
|
|
|
|
2001-07-29 09:13:16 -04:00
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
|
2001-07-29 05:17:53 -04:00
|
|
|
TXT_SCRIPT_LIST_FOOTER);
|
|
|
|
}
|
|
|
|
|
2004-06-29 06:07:03 -04:00
|
|
|
static void cmd_load(const char *data, SERVER_REC *server, void *item)
|
|
|
|
{
|
|
|
|
char *rootmodule, *submodule;
|
|
|
|
void *free_arg;
|
|
|
|
size_t len;
|
|
|
|
|
|
|
|
if (!cmd_get_params(data, &free_arg, 2 , &rootmodule, &submodule))
|
|
|
|
return;
|
|
|
|
|
|
|
|
len = strlen(rootmodule);
|
2015-04-07 21:39:05 -04:00
|
|
|
if (len > 3 && g_strcmp0(rootmodule + len - 3, ".pl") == 0) {
|
2004-06-29 06:07:03 -04:00
|
|
|
/* make /LOAD script.pl work as expected */
|
|
|
|
signal_stop();
|
|
|
|
cmd_script_load(data);
|
|
|
|
}
|
|
|
|
|
|
|
|
cmd_params_free(free_arg);
|
|
|
|
}
|
|
|
|
|
2001-07-29 05:17:53 -04:00
|
|
|
static void sig_script_error(PERL_SCRIPT_REC *script, const char *error)
|
|
|
|
{
|
|
|
|
printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
|
2001-07-29 09:13:16 -04:00
|
|
|
TXT_SCRIPT_ERROR, script == NULL ? "??" : script->name);
|
2001-07-29 05:17:53 -04:00
|
|
|
|
|
|
|
printtext(NULL, NULL, MSGLEVEL_CLIENTERROR, "%[-s]%s", error);
|
|
|
|
}
|
|
|
|
|
|
|
|
static void sig_complete_load(GList **list, WINDOW_REC *window,
|
|
|
|
const char *word, const char *line,
|
|
|
|
int *want_space)
|
|
|
|
{
|
|
|
|
char *user_dir;
|
|
|
|
|
|
|
|
if (*line != '\0')
|
|
|
|
return;
|
|
|
|
|
|
|
|
/* completing filename parameter for /SCRIPT LOAD */
|
|
|
|
user_dir = g_strdup_printf("%s/scripts", get_irssi_dir());
|
|
|
|
*list = filename_complete(word, user_dir);
|
|
|
|
*list = g_list_concat(*list, filename_complete(word, SCRIPTDIR));
|
|
|
|
g_free(user_dir);
|
|
|
|
|
|
|
|
if (*list != NULL) {
|
|
|
|
*want_space = FALSE;
|
|
|
|
signal_stop();
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
static GList *script_complete(const char *name)
|
|
|
|
{
|
|
|
|
GSList *tmp;
|
|
|
|
GList *list;
|
|
|
|
int len;
|
|
|
|
|
|
|
|
list = NULL;
|
|
|
|
len = strlen(name);
|
|
|
|
for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
|
|
|
|
PERL_SCRIPT_REC *rec = tmp->data;
|
|
|
|
|
|
|
|
if (strncmp(rec->name, name, len) == 0)
|
2002-01-23 15:36:52 -05:00
|
|
|
list = g_list_append(list, g_strdup(rec->name));
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
return list;
|
|
|
|
}
|
|
|
|
|
|
|
|
static void sig_complete_unload(GList **list, WINDOW_REC *window,
|
|
|
|
const char *word, const char *line,
|
|
|
|
int *want_space)
|
|
|
|
{
|
|
|
|
if (*line != '\0')
|
|
|
|
return;
|
|
|
|
|
|
|
|
/* completing script parameter for /SCRIPT UNLOAD */
|
|
|
|
*list = script_complete(word);
|
|
|
|
if (*list != NULL)
|
|
|
|
signal_stop();
|
|
|
|
}
|
|
|
|
|
|
|
|
void fe_perl_init(void)
|
|
|
|
{
|
|
|
|
theme_register(feperl_formats);
|
|
|
|
|
|
|
|
command_bind("script", NULL, (SIGNAL_FUNC) cmd_script);
|
|
|
|
command_bind("script exec", NULL, (SIGNAL_FUNC) cmd_script_exec);
|
|
|
|
command_bind("script load", NULL, (SIGNAL_FUNC) cmd_script_load);
|
|
|
|
command_bind("script unload", NULL, (SIGNAL_FUNC) cmd_script_unload);
|
2001-07-30 09:06:21 -04:00
|
|
|
command_bind("script reset", NULL, (SIGNAL_FUNC) cmd_script_reset);
|
2001-07-29 05:17:53 -04:00
|
|
|
command_bind("script list", NULL, (SIGNAL_FUNC) cmd_script_list);
|
2004-06-29 06:07:03 -04:00
|
|
|
command_bind("load", NULL, (SIGNAL_FUNC) cmd_load);
|
2001-07-29 05:17:53 -04:00
|
|
|
command_set_options("script exec", "permanent");
|
|
|
|
|
|
|
|
signal_add("script error", (SIGNAL_FUNC) sig_script_error);
|
|
|
|
signal_add("complete command script load", (SIGNAL_FUNC) sig_complete_load);
|
|
|
|
signal_add("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
|
2001-08-13 20:41:59 -04:00
|
|
|
|
2001-10-20 09:19:25 -04:00
|
|
|
perl_core_print_script_error(FALSE);
|
2001-08-13 20:41:59 -04:00
|
|
|
module_register("perl", "fe");
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void fe_perl_deinit(void)
|
|
|
|
{
|
2009-01-15 06:02:23 -05:00
|
|
|
theme_unregister();
|
|
|
|
|
2001-07-29 05:17:53 -04:00
|
|
|
command_unbind("script", (SIGNAL_FUNC) cmd_script);
|
|
|
|
command_unbind("script exec", (SIGNAL_FUNC) cmd_script_exec);
|
|
|
|
command_unbind("script load", (SIGNAL_FUNC) cmd_script_load);
|
|
|
|
command_unbind("script unload", (SIGNAL_FUNC) cmd_script_unload);
|
2001-07-30 09:06:21 -04:00
|
|
|
command_unbind("script reset", (SIGNAL_FUNC) cmd_script_reset);
|
2001-07-29 05:17:53 -04:00
|
|
|
command_unbind("script list", (SIGNAL_FUNC) cmd_script_list);
|
2004-06-29 06:07:03 -04:00
|
|
|
command_unbind("load", (SIGNAL_FUNC) cmd_load);
|
2001-07-29 05:17:53 -04:00
|
|
|
|
|
|
|
signal_remove("script error", (SIGNAL_FUNC) sig_script_error);
|
|
|
|
signal_remove("complete command script load", (SIGNAL_FUNC) sig_complete_load);
|
|
|
|
signal_remove("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
|
2001-10-20 09:19:25 -04:00
|
|
|
|
|
|
|
perl_core_print_script_error(TRUE);
|
2001-07-29 05:17:53 -04:00
|
|
|
}
|