/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

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;