From 062d6628341d31d03ea8ed5eeb8c446c060d4a3a Mon Sep 17 00:00:00 2001
From: Timo Sirainen <cras@irssi.org>
Date: Sat, 9 Dec 2000 21:58:53 +0000
Subject: [PATCH] /perl command does now "use Irssi::Proto" for all chat
protocols that have .pm file in @INC
git-svn-id: http://svn.irssi.org/repos/irssi/trunk@983 dbcabf3a-b0e7-0310-adc4-f8d773084564
---
src/perl/perl-common.c | 54 +++++++++++++++++++++++++++++++++++++++---
src/perl/perl-common.h | 2 ++
src/perl/perl.c | 16 +++++++++----
3 files changed, 65 insertions(+), 7 deletions(-)
diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c
index b81a95a5..e7333ff1 100644
--- a/src/perl/perl-common.c
+++ b/src/perl/perl-common.c
@@ -30,6 +30,7 @@
#include "module.h"
#include "modules.h"
#include "signals.h"
+#include "misc.h"
#include "settings.h"
#include "commands.h"
@@ -55,6 +56,7 @@ typedef struct {
} PERL_OBJECT_REC;
static GHashTable *iobject_stashes, *plain_stashes;
+static GSList *use_protocols;
/* returns the package who called us */
char *perl_get_package(void)
@@ -139,6 +141,22 @@ void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects)
}
}
+char *perl_get_use_list(void)
+{
+ GString *str;
+ GSList *tmp;
+ char *ret;
+
+ str = g_string_new(NULL);
+
+ for (tmp = use_protocols; tmp != NULL; tmp = tmp->next)
+ g_string_sprintfa(str, "use Irssi::%s;", (char *) tmp->data);
+
+ ret = str->str;
+ g_string_free(str, FALSE);
+ return ret;
+}
+
void perl_connect_fill_hash(HV *hv, SERVER_CONNECT_REC *conn)
{
char *type, *chat_type;
@@ -425,8 +443,16 @@ static void perl_register_protocol(CHAT_PROTOCOL_REC *rec)
"Channel", "Query",
"Nick"
};
- char *name, stash[100], code[100];
+ static char *find_use_code =
+ "my $pkg = Irssi::%s; $pkg =~ s/::/\\//;\n"
+ "foreach my $i (@INC) {\n"
+ " return 1 if (-f \"$i/$pkg.pm\");\n"
+ "}\n"
+ "return 0;\n";
+
+ char *name, stash[100], code[100], *pcode;
int type, chat_type, n;
+ SV *sv;
chat_type = chat_protocol_lookup(rec->name);
g_return_if_fail(chat_type >= 0);
@@ -469,6 +495,16 @@ static void perl_register_protocol(CHAT_PROTOCOL_REC *rec)
name, items[n], items[n]);
perl_eval_pv(code, TRUE);
}
+
+ pcode = g_strdup_printf(find_use_code, name);
+ sv = perl_eval_pv(pcode, TRUE);
+ g_free(pcode);
+
+ if (SvIV(sv)) {
+ use_protocols =
+ g_slist_append(use_protocols, g_strdup(name));
+ }
+
g_free(name);
}
@@ -478,7 +514,7 @@ static void free_iobject_hash(void *key, PERL_OBJECT_REC *rec)
g_free(rec);
}
-static int perl_free_protocol(void *key, void *value, void *chat_type)
+static int free_iobject_proto(void *key, void *value, void *chat_type)
{
if ((GPOINTER_TO_INT(key) >> 24) == GPOINTER_TO_INT(chat_type)) {
free_iobject_hash(key, value);
@@ -490,7 +526,16 @@ static int perl_free_protocol(void *key, void *value, void *chat_type)
static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec)
{
- g_hash_table_foreach_remove(iobject_stashes, (GHRFunc) perl_free_protocol,
+ GSList *item;
+
+ item = gslist_find_icase_string(use_protocols, rec->name);
+ if (item != NULL) {
+ g_free(item->data);
+ use_protocols =
+ g_slist_remove(use_protocols, item->data);
+ }
+ g_hash_table_foreach_remove(iobject_stashes,
+ (GHRFunc) free_iobject_proto,
GINT_TO_POINTER(rec->id));
}
@@ -537,6 +582,9 @@ void perl_common_deinit(void)
g_hash_table_foreach(plain_stashes, (GHFunc) g_free, NULL);
g_hash_table_destroy(plain_stashes);
+ g_slist_foreach(use_protocols, (GFunc) g_free, NULL);
+ g_slist_free(use_protocols);
+
signal_remove("chat protocol created", (SIGNAL_FUNC) sig_protocol_created);
signal_remove("chat protocol destroyed", (SIGNAL_FUNC) sig_protocol_destroyed);
}
diff --git a/src/perl/perl-common.h b/src/perl/perl-common.h
index cdbd7e2e..06f085a6 100644
--- a/src/perl/perl-common.h
+++ b/src/perl/perl-common.h
@@ -39,6 +39,8 @@ void irssi_add_object(int type, int chat_type, const char *stash,
void irssi_add_plain(const char *stash, PERL_OBJECT_FUNC func);
void irssi_add_plains(PLAIN_OBJECT_INIT_REC *objects);
+char *perl_get_use_list(void);
+
void perl_common_init(void);
void perl_common_deinit(void);
diff --git a/src/perl/perl.c b/src/perl/perl.c
index e9fb27cb..943636fc 100644
--- a/src/perl/perl.c
+++ b/src/perl/perl.c
@@ -381,16 +381,24 @@ static void cmd_run(const char *data)
static void cmd_perl(const char *data)
{
dSP;
- GString *code;
+ GString *code;
+ char *uses;
+ SV *sv;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- code = g_string_new("use Irssi;\n");
- g_string_append(code, data);
- perl_eval_pv(code->str, G_NOARGS|G_EVAL|G_DISCARD);
+ code = g_string_new(NULL);
+
+ uses = perl_get_use_list();
+ g_string_sprintf(code, "sub { use Irssi;%s\n%s }", uses, data);
+
+ sv = perl_eval_pv(code->str, TRUE);
+ perl_call_sv(sv, G_VOID|G_NOARGS|G_EVAL|G_DISCARD);
+
+ g_free(uses);
g_string_free(code, TRUE);
SPAGAIN;