# HG changeset patch
# User Eric Warmenhoven <eric@warmenhoven.org>
# Date 965095723 0
# Node ID 9b36c91cce261a0dde372253f51da2b0fa0e636f
# Parent  cf3da01f451cb0aa5b82e7c2701d9f3fafd5de79
[gaim-migrate @ 571]
more perl stuff.

committer: Tailor Script <tailor@pidgin.im>

diff -r cf3da01f451c -r 9b36c91cce26 src/gaim.h
--- a/src/gaim.h	Mon Jul 31 19:44:49 2000 +0000
+++ b/src/gaim.h	Tue Aug 01 02:08:43 2000 +0000
@@ -98,7 +98,9 @@
 #ifndef USE_APPLET
 #ifdef ENABLE_NLS
 #  include <libintl.h>
-#  define _(x) gettext(x)
+#  ifndef _ /* perl wackiness causes this */
+#    define _(x) gettext(x)
+#  endif
 #  ifdef gettext_noop
 #    define N_(String) gettext_noop (String)
 #  else
@@ -402,7 +404,7 @@
 #define TYPE_SIGNOFF   4
 #define TYPE_KEEPALIVE 5
 
-#define REVISION "gaim:$Revision: 565 $"
+#define REVISION "gaim:$Revision: 571 $"
 #define FLAPON "FLAPON\r\n\r\n"
 
 #define ROAST "Tic/Toc"
diff -r cf3da01f451c -r 9b36c91cce26 src/perl.c
--- a/src/perl.c	Mon Jul 31 19:44:49 2000 +0000
+++ b/src/perl.c	Tue Aug 01 02:08:43 2000 +0000
@@ -26,10 +26,9 @@
 #ifdef HAVE_CONFIG_H
 #include "../config.h"
 #endif
-#undef PACKAGE /* no idea why, just following X-Chat */
+#undef PACKAGE
 
-/* #ifdef USE_PERL */
-#if 0 /* this isn't ready for prime-time yet. not even the 3-am shows. */
+#ifdef USE_PERL
 
 #include <EXTERN.h>
 #ifndef _SEM_SEMUN_UNDEFINED
@@ -45,25 +44,82 @@
 #include <stdio.h>
 #include "gaim.h"
 
+struct perlscript {
+	char *name;
+	char *version;
+	char *shutdowncallback; /* bleh */
+};
+
+static GList *perl_list = NULL;
 static PerlInterpreter *my_perl = NULL;
 
-XS (XS_AIM_register); /* so far so good */
-XS (XS_AIM_add_message_handler); /* um... */
-XS (XS_AIM_add_command_handler); /* once again, um... */
-XS (XS_AIM_add_print_handler); /* can i really do this? */
-XS (XS_AIM_add_timeout_handler); /* ok, this i can do */
-XS (XS_AIM_print); /* how am i going to do this */
-XS (XS_AIM_print_with_channel); /* FIXME! this needs to be renamed */
-XS (XS_AIM_send_raw); /* this i can do for toc, but for oscar... ? */
-XS (XS_AIM_command); /* this should be easier */
-XS (XS_AIM_command_with_server); /* FIXME: this should probably be removed */
-XS (XS_AIM_channel_list); /* probably return conversation list */
-XS (XS_AIM_server_list); /* huh? does this apply? */
-XS (XS_AIM_user_list); /* return the buddy list */
-XS (XS_AIM_user_info); /* we'll see.... */
-XS (XS_AIM_ignore_list); /* deny list? */
-XS (XS_AIM_dcc_list); /* wha? */
-XS (XS_AIM_get_info); /* this i can do too */
+XS (XS_AIM_register);			/* so far so good */
+/* XS (XS_AIM_add_message_handler);	/* um... */
+/* XS (XS_AIM_add_command_handler);	/* once again, um... */
+/* XS (XS_AIM_add_print_handler);	/* can i really do this? */
+XS (XS_AIM_add_timeout_handler);	/* ok, this i can do */
+/* XS (XS_AIM_print);			/* how am i going to do this */
+/* XS (XS_AIM_print_with_channel);	/* print_to_conversation? */
+/* XS (XS_AIM_send_raw);		/* this i can do for toc, but for oscar... ? */
+XS (XS_AIM_command);			/* this should be easier */
+/* XS (XS_AIM_command_with_server);	/* FIXME: this should probably be removed */
+XS (XS_AIM_channel_list);		/* probably return conversation list */
+/* XS (XS_AIM_server_list);		/* huh? does this apply? */
+XS (XS_AIM_user_list);			/* return the buddy list */
+/* XS (XS_AIM_user_info);		/* we'll see.... */
+XS (XS_AIM_ignore_list);		/* deny list? */
+/* XS (XS_AIM_dcc_list);		/* wha? */
+XS (XS_AIM_get_info);			/* this i can do too */
+
+/* perl module support */
+extern void xs_init _((void));
+extern void boot_DynaLoader _((CV * cv)); /* perl is so wacky */
+
+void xs_init()
+{
+	char *file = __FILE__;
+	newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+static char *escape_quotes(char *buf)
+{
+	static char *tmp_buf = NULL;
+	char *i, *j;
+
+	if (tmp_buf)
+		g_free(tmp_buf);
+	tmp_buf = g_malloc(strlen(buf) * 2 + 1);
+	for (i = buf, j = tmp_buf; *i; i++, j++) {
+		if (*i == '\'' || *i == '\\')
+			*j++ = '\\';
+		*j = *i;
+	}
+	*j = '\0';
+
+	return (tmp_buf);
+}
+
+static SV *execute_perl(char *function, char *args)
+{
+	static char *perl_cmd = NULL;
+
+	if (perl_cmd)
+		g_free(perl_cmd);
+	perl_cmd = g_malloc(strlen(function) + strlen(args) + 2 + 10);
+	sprintf(perl_cmd, "&%s('%s')", function, escape_quotes(args));
+#ifndef HAVE_PERL_EVAL_PV
+	return (perl_eval_pv(perl_cmd, TRUE));
+#else
+	return (Perl_eval_pv(perl_cmd, TRUE));
+#endif
+}
+
+int perl_load_file(char *script_name)
+{
+	SV *return_val;
+	return_val = execute_perl("load_file", script_name);
+	return SvNV (return_val);
+}
 
 void perl_init(int autoload)
 {
@@ -84,30 +140,30 @@
 
 	my_perl = perl_alloc();
 	perl_construct(my_perl);
-	perl_parse(my_perl, NULL, 3, perl_args, NULL);
+	perl_parse(my_perl, xs_init, 4, perl_args, NULL);
 #ifndef HAVE_PERL_EVAL_PV
 	perl_eval_pv(load_file, TRUE);
 #else
 	Perl_eval_pv(load_file, TRUE);
 #endif
 
-	newXS("AIM::register", XS_AIM_register, "AIM");
-	newXS("AIM::add_message_handler", XS_AIM_add_message_handler, "AIM");
-	newXS("AIM::add_command_handler", XS_AIM_add_command_handler, "AIM");
-	newXS("AIM::add_print_handler", XS_AIM_add_print_handler, "AIM");
-	newXS("AIM::add_timeout_handler", XS_AIM_add_timeout_handler, "AIM");
-	newXS("AIM::print", XS_AIM_print, "AIM");
-	newXS("AIM::print_with_channel", XS_AIM_print_with_channel, "AIM");
-	newXS("AIM::send_raw", XS_AIM_send_raw, "AIM");
-	newXS("AIM::command", XS_AIM_command, "AIM");
-	newXS("AIM::command_with_server", XS_AIM_command_with_server, "AIM");
-	newXS("AIM::channel_list", XS_AIM_channel_list, "AIM");
-	newXS("AIM::server_list", XS_AIM_server_list, "AIM");
-	newXS("AIM::user_list", XS_AIM_user_list, "AIM");
-	newXS("AIM::user_info", XS_AIM_user_info, "AIM");
-	newXS("AIM::ignore_list", XS_AIM_ignore_list, "AIM");
-	newXS("AIM::dcc_list", XS_AIM_dcc_list, "AIM");
-	newXS("AIM::get_info", XS_AIM_get_info, "AIM");
+	newXS ("AIM::register", XS_AIM_register, "AIM");
+/*	newXS ("AIM::add_message_handler", XS_AIM_add_message_handler, "AIM"); */
+/*	newXS ("AIM::add_command_handler", XS_AIM_add_command_handler, "AIM"); */
+/*	newXS ("AIM::add_print_handler", XS_AIM_add_print_handler, "AIM"); */
+	newXS ("AIM::add_timeout_handler", XS_AIM_add_timeout_handler, "AIM");
+/*	newXS ("AIM::print", XS_AIM_print, "AIM"); */
+/*	newXS ("AIM::print_with_channel", XS_AIM_print_with_channel, "AIM"); */
+/*	newXS ("AIM::send_raw", XS_AIM_send_raw, "AIM"); */
+	newXS ("AIM::command", XS_AIM_command, "AIM");
+/*	newXS ("AIM::command_with_server", XS_AIM_command_with_server, "AIM"); */
+	newXS ("AIM::channel_list", XS_AIM_channel_list, "AIM");
+/*	newXS ("AIM::server_list", XS_AIM_server_list, "AIM"); */
+	newXS ("AIM::user_list", XS_AIM_user_list, "AIM");
+/*	newXS ("AIM::user_info", XS_AIM_user_info, "AIM"); */
+	newXS ("AIM::ignore_list", XS_AIM_ignore_list, "AIM");
+/*	newXS ("AIM::dcc_list", XS_AIM_dcc_list, "AIM"); */
+	newXS ("AIM::get_info", XS_AIM_get_info, "AIM");
 
 	/* FIXME */
 	if (autoload) {
@@ -124,4 +180,67 @@
 	}
 }
 
+XS (XS_AIM_register)
+{
+	char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */
+	int junk;
+	struct perlscript *scp;
+	dXSARGS;
+	items = 0;
+
+	name = SvPV (ST (0), junk);
+	ver = SvPV (ST (1), junk);
+	callback = SvPV (ST (2), junk);
+	unused = SvPV (ST (3), junk);
+
+	scp = g_new0(struct perlscript, 1);
+	scp->name = g_strdup(name);
+	scp->version = g_strdup(ver);
+	scp->shutdowncallback = g_strdup(callback);
+	perl_list = g_list_append(perl_list, scp);
+
+	XST_mPV (0, VERSION);
+	XSRETURN (1);
+}
+
+/* XS (XS_AIM_add_message_handler);	/* um... */
+/* XS (XS_AIM_add_command_handler);	/* once again, um... */
+/* XS (XS_AIM_add_print_handler);	/* can i really do this? */
+
+XS (XS_AIM_add_timeout_handler)
+{
+}
+
+/* XS (XS_AIM_print);			/* how am i going to do this */
+/* XS (XS_AIM_print_with_channel);	/* print_to_conversation? */
+/* XS (XS_AIM_send_raw);		/* this i can do for toc, but for oscar... ? */
+
+XS (XS_AIM_command)
+{
+}
+
+/* XS (XS_AIM_command_with_server);	/* FIXME: this should probably be removed */
+
+XS (XS_AIM_channel_list)
+{
+}
+
+/* XS (XS_AIM_server_list);		/* huh? does this apply? */
+
+XS (XS_AIM_user_list)
+{
+}
+
+/* XS (XS_AIM_user_info);		/* we'll see.... */
+
+XS (XS_AIM_ignore_list)
+{
+}
+
+/* XS (XS_AIM_dcc_list);		/* wha? */
+
+XS (XS_AIM_get_info)
+{
+}
+
 #endif /* USE_PERL */