apps/irssi/src/perl/perl-fe.c

   1 /*
   2  perl-core.c : irssi
   3
   4     Copyright (C) 1999-2001 Timo Sirainen
   5
   6     This program is free software; you can redistribute it and/or modify
   7     it under the terms of the GNU General Public License as published by
   8     the Free Software Foundation; either version 2 of the License, or
   9     (at your option) any later version.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14     GNU General Public License for more details.
  15
  16     You should have received a copy of the GNU General Public License
  17     along with this program; if not, write to the Free Software
  18     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 */
  20
  21 #include "module-fe.h"
  22 #include "modules.h"
  23 #include "module-formats.h"
  24 #include "signals.h"
  25 #include "commands.h"
  26 #include "levels.h"
  27
  28 #include "printtext.h"
  29 #include "completion.h"
  30
  31 #include "perl-core.h"
  32
  33 static void cmd_script(const char *data, SERVER_REC *server, void *item)
  34 {
  35         if (*data == '\0')
  36                 data = "list";
  37
  38         command_runsub("script", data, server, item);
  39 }
  40
  41 static void cmd_script_exec(const char *data)
  42 {
  43         PERL_SCRIPT_REC *script;
  44         GHashTable *optlist;
  45         char *code;
  46         void *free_arg;
  47
  48         if (!cmd_get_params(data, &free_arg, 1 | PARAM_FLAG_OPTIONS |
  49                             PARAM_FLAG_GETREST,
  50                             "script exec", &optlist, &code))
  51                 return;
  52
  53         if (*code == '\0')
  54                 cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
  55
  56         script = perl_script_load_data(code);
  57         if (script != NULL &&
  58             g_hash_table_lookup(optlist, "permanent") == NULL) {
  59                 /* not a permanent script, unload immediately */
  60                 perl_script_unload(script);
  61         }
  62
  63
  64         cmd_params_free(free_arg);
  65 }
  66
  67 static void cmd_script_load(const char *data)
  68 {
  69         PERL_SCRIPT_REC *script;
  70         char *fname, *path;
  71         void *free_arg;
  72
  73         if (!cmd_get_params(data, &free_arg, 1, &path))
  74                 return;
  75
  76         if (*path == '\0')
  77                 cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
  78
  79         fname = perl_script_get_path(path);
  80         if (fname == NULL) {
  81                 printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
  82                             TXT_SCRIPT_NOT_FOUND, data);
  83         } else {
  84                 script = perl_script_load_file(fname);
  85                 if (script != NULL) {
  86                         printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
  87                                     TXT_SCRIPT_LOADED,
  88                                     script->name, script->path);
  89                 }
  90                 g_free(fname);
  91         }
  92         cmd_params_free(free_arg);
  93 }
  94
  95 static void cmd_script_unload(const char *data)
  96 {
  97         PERL_SCRIPT_REC *script;
  98         char *name;
  99         void *free_arg;
 100
 101         if (!cmd_get_params(data, &free_arg, 1, &name))
 102                 return;
 103
 104         if (*name == '\0')
 105                 cmd_param_error(CMDERR_NOT_ENOUGH_PARAMS);
 106
 107         script_fix_name(name);
 108         script = perl_script_find(name);
 109         if (script == NULL) {
 110                 printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
 111                             TXT_SCRIPT_NOT_LOADED, name);
 112         } else {
 113                 printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
 114                             TXT_SCRIPT_UNLOADED, script->name);
 115                 perl_script_unload(script);
 116         }
 117         cmd_params_free(free_arg);
 118 }
 119
 120 static void cmd_script_reset(const char *data)
 121 {
 122         perl_scripts_deinit();
 123         perl_scripts_init();
 124 }
 125
 126 static void cmd_script_list(void)
 127 {
 128         GSList *tmp;
 129         GString *data;
 130
 131         if (perl_scripts == NULL) {
 132                 printformat(NULL, NULL, MSGLEVEL_CLIENTNOTICE,
 133                             TXT_NO_SCRIPTS_LOADED);
 134                 return;
 135         }
 136
 137         printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
 138                     TXT_SCRIPT_LIST_HEADER);
 139
 140         data = g_string_new(NULL);
 141         for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
 142                 PERL_SCRIPT_REC *rec = tmp->data;
 143
 144                 if (rec->path != NULL)
 145                         g_string_assign(data, rec->path);
 146                 else {
 147                         g_string_assign(data, rec->data);
 148                         if (data->len > 50) {
 149                                 g_string_truncate(data, 50);
 150                                 g_string_append(data, " ...");
 151                         }
 152                 }
 153
 154                 printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
 155                             TXT_SCRIPT_LIST_LINE, rec->name, data->str);
 156         }
 157         g_string_free(data, TRUE);
 158
 159         printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP,
 160                     TXT_SCRIPT_LIST_FOOTER);
 161 }
 162
 163 static void cmd_load(const char *data, SERVER_REC *server, void *item)
 164 {
 165         char *rootmodule, *submodule;
 166         void *free_arg;
 167         size_t len;
 168
 169         if (!cmd_get_params(data, &free_arg, 2 , &rootmodule, &submodule))
 170                 return;
 171
 172         len = strlen(rootmodule);
 173         if (len > 3 && strcmp(rootmodule + len - 3, ".pl") == 0) {
 174                 /* make /LOAD script.pl work as expected */
 175                 signal_stop();
 176                 cmd_script_load(data);
 177         }
 178
 179         cmd_params_free(free_arg);
 180 }
 181
 182 static void sig_script_error(PERL_SCRIPT_REC *script, const char *error)
 183 {
 184         printformat(NULL, NULL, MSGLEVEL_CLIENTERROR,
 185                     TXT_SCRIPT_ERROR, script == NULL ? "??" : script->name);
 186
 187         printtext(NULL, NULL, MSGLEVEL_CLIENTERROR, "%[-s]%s", error);
 188 }
 189
 190 static void sig_complete_load(GList **list, WINDOW_REC *window,
 191                               const char *word, const char *line,
 192                               int *want_space)
 193 {
 194         char *user_dir;
 195
 196         if (*line != '\0')
 197                 return;
 198
 199         /* completing filename parameter for /SCRIPT LOAD */
 200         user_dir = g_strdup_printf("%s/scripts", get_irssi_dir());
 201         *list = filename_complete(word, user_dir);
 202         *list = g_list_concat(*list, filename_complete(word, SCRIPTDIR));
 203         g_free(user_dir);
 204
 205         if (*list != NULL) {
 206                 *want_space = FALSE;
 207                 signal_stop();
 208         }
 209 }
 210
 211 static GList *script_complete(const char *name)
 212 {
 213         GSList *tmp;
 214         GList *list;
 215         int len;
 216
 217         list = NULL;
 218         len = strlen(name);
 219         for (tmp = perl_scripts; tmp != NULL; tmp = tmp->next) {
 220                 PERL_SCRIPT_REC *rec = tmp->data;
 221
 222                 if (strncmp(rec->name, name, len) == 0)
 223                         list = g_list_append(list, g_strdup(rec->name));
 224         }
 225
 226         return list;
 227 }
 228
 229 static void sig_complete_unload(GList **list, WINDOW_REC *window,
 230                                 const char *word, const char *line,
 231                                 int *want_space)
 232 {
 233         if (*line != '\0')
 234                 return;
 235
 236         /* completing script parameter for /SCRIPT UNLOAD */
 237         *list = script_complete(word);
 238         if (*list != NULL)
 239                 signal_stop();
 240 }
 241
 242 void fe_perl_init(void)
 243 {
 244         theme_register(feperl_formats);
 245
 246         command_bind("script", NULL, (SIGNAL_FUNC) cmd_script);
 247         command_bind("script exec", NULL, (SIGNAL_FUNC) cmd_script_exec);
 248         command_bind("script load", NULL, (SIGNAL_FUNC) cmd_script_load);
 249         command_bind("script unload", NULL, (SIGNAL_FUNC) cmd_script_unload);
 250         command_bind("script reset", NULL, (SIGNAL_FUNC) cmd_script_reset);
 251         command_bind("script list", NULL, (SIGNAL_FUNC) cmd_script_list);
 252         command_bind("load", NULL, (SIGNAL_FUNC) cmd_load);
 253         command_set_options("script exec", "permanent");
 254
 255         signal_add("script error", (SIGNAL_FUNC) sig_script_error);
 256         signal_add("complete command script load", (SIGNAL_FUNC) sig_complete_load);
 257         signal_add("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
 258
 259         perl_core_print_script_error(FALSE);
 260         module_register("perl", "fe");
 261 }
 262
 263 void fe_perl_deinit(void)
 264 {
 265         command_unbind("script", (SIGNAL_FUNC) cmd_script);
 266         command_unbind("script exec", (SIGNAL_FUNC) cmd_script_exec);
 267         command_unbind("script load", (SIGNAL_FUNC) cmd_script_load);
 268         command_unbind("script unload", (SIGNAL_FUNC) cmd_script_unload);
 269         command_unbind("script reset", (SIGNAL_FUNC) cmd_script_reset);
 270         command_unbind("script list", (SIGNAL_FUNC) cmd_script_list);
 271         command_unbind("load", (SIGNAL_FUNC) cmd_load);
 272
 273         signal_remove("script error", (SIGNAL_FUNC) sig_script_error);
 274         signal_remove("complete command script load", (SIGNAL_FUNC) sig_complete_load);
 275         signal_remove("complete command script unload", (SIGNAL_FUNC) sig_complete_unload);
 276
 277         perl_core_print_script_error(TRUE);
 278 }