Mercurial > pidgin.yaz

--- a/ChangeLog	Tue Aug 19 21:09:56 2003 +0000
+++ b/ChangeLog	Tue Aug 19 21:47:36 2003 +0000
@@ -4,9 +4,11 @@
 	* Removed the old event system and replaced it with a much better
 	  signal system.
 	* Added plugin dependency support.
+	* Rewrote the Perl plugin. All old scripts will break, but it offers
+	  a much better API for new scripts.
 	* Swedish translation updated (Tore Lundqvist (luntor))
 	* German translation updated (Bjoern Voigt)
-
+
 version 0.67 (08/14/2003):
 	* Brought back the message notification plugin (Brian Tarricone)
 	  You'll need to reconfigure your settings for this plugin
--- a/configure.ac	Tue Aug 19 21:09:56 2003 +0000
+++ b/configure.ac	Tue Aug 19 21:47:36 2003 +0000
@@ -222,11 +222,9 @@
 GC_TM_GMTOFF


-
-dnl This was taken straight from X-Chat.
-dnl X-Chat is the greatest application ever, not only
-dnl because it's a rocking IRC client but also because
-dnl it's very easy to learn from.
+dnl
+dnl Perl stuff. Yeah.
+dnl
 if test "$enable_perl" = yes ; then
 	AC_PATH_PROG(perlpath, perl)
 	AC_MSG_CHECKING(for Perl compile flags)
@@ -271,6 +269,56 @@
 	else
 		AC_MSG_RESULT(no)
 	fi
+
+	AC_ARG_WITH(perl-lib,
+	[  --with-perl-lib=[site|vendor|DIR]  Specify where to install the
+	                           Perl libraries for gaim. Default is site.],
+	[
+		if test "x$withval" = xsite; then
+			PERL_MM_PARAMS=""
+		elif test "x$withval" = xvendor; then
+			if test -z "`$perlpath -v | grep '5\.0'`"; then
+				PERL_MM_PARAMS="INSTALLDIRS=vendor"
+			else
+				PERL_MM_PARAMS="INSTALLDIRS=perl PREFIX=`perl -e 'use Config; print $Config{prefix}'`"
+			fi
+		else
+			PERL_MM_PARAMS="INSTALLDIRS=perl LIB=$withval"
+		fi
+	])
+
+	AC_MSG_CHECKING(for DynaLoader.a)
+	DYNALOADER_A=`echo $PERL_LDFLAGS | $perlpath -pe 's/^(.* )*([[^ ]]*DynaLoader\.a).*/\2/'`
+
+	dnl Don't check libperl.a if dynaloader.a wasn't found.
+	if test -n "$DYNALOADER_A"; then
+		AC_MSG_RESULT(yes)
+
+		dnl Find either libperl.a or libperl.so
+		AC_MSG_CHECKING(for libperl.a or libperl.so)
+		LIBPERL_A=`echo "$PERL_LDFLAGS -L/usr/lib"|$perlpath -e 'foreach (split(/ /, <STDIN>)) { if (/^-L(.*)/) { my $dir=$1; if (\`ls $dir/libperl.so* 2>/dev/null\`) { print "-lperl"; last; }; if (-e "$dir/libperl.a") { print "$dir/libperl.a"; last } } };'`
+		if test -z "$LIBPERL_A"; then
+			AC_MSG_RESULT(no)
+			DYNALOADER_A=
+		else
+			AC_MSG_RESULT(yes)
+
+			if test "$LIBPERL_A" = "-lperl"; then
+				LIBPERL_A=
+			fi
+		fi
+
+		PERL_LIBS=`echo $PERL_LIBS | $perlpath -pe 's/^(.* )*[[^ ]]*DynaLoader\.a/\1libperl_dynaloader.la/'`
+
+		if test -n "$LIBPERL_A"; then
+			PERL_LIBS=`echo $PERL_LDFLAGS | $sedpath -e 's/-lperl /libperl_orig.la /' -e 's/-lperl$/libperl_orig.la$/'`
+		fi
+
+		AC_SUBST(DYNALOADER_A)
+		AC_SUBST(LIBPERL_A)
+	else
+		AC_MSG_RESULT(no)
+	fi
 else
 	PERL_CFLAGS=
 	PERL_LIBS=
@@ -409,8 +457,9 @@
 	   plugins/gaim-remote/Makefile
 	   plugins/gestures/Makefile
 	   plugins/perl/Makefile
+	   plugins/perl/common/Makefile.PL
 	   plugins/ticker/Makefile
-	   po/Makefile.in
+	   po/Makefile.in
            sounds/Makefile
 	   src/Makefile
 	   src/protocols/Makefile
--- a/plugins/perl/.cvsignore	Tue Aug 19 21:09:56 2003 +0000
+++ b/plugins/perl/.cvsignore	Tue Aug 19 21:47:36 2003 +0000
@@ -5,3 +5,4 @@
 *.dll
 *.la
 *.lo
+*.a
--- a/plugins/perl/Makefile.am	Tue Aug 19 21:09:56 2003 +0000
+++ b/plugins/perl/Makefile.am	Tue Aug 19 21:47:36 2003 +0000
@@ -1,13 +1,81 @@
-EXTRA_DIST = \
-		Makefile.mingw
-
 plugindir = $(libdir)/gaim

-perl_la_LDFLAGS = -module -avoid-version $(PERL_LIBS)
+perl_dirs = common

 plugin_LTLIBRARIES = perl.la

-perl_la_SOURCES = perl.c
+perl_la_LDFLAGS = -module -avoid-version $(PERL_LIBS)
+perl_la_LIBADD = $(PERL_LDFLAGS)
+perl_la_SOURCES = \
+	perl.c \
+	perl-common.c
+
+perl_la_DEPENDENCIES = \
+	.libs/libperl_orig.a \
+	.libs/DynaLoader.a
+
+.libs/libperl_orig.a:
+	@if [ ! -d .libs ]; then mkdir .libs; fi
+	@rm -f .libs/libperl_orig.a
+	@if [ x$(LIBPERL_A) = x ]; then \
+		touch .libs/libperl_orig.a; \
+	else \
+		$(LN_S) $(LIBPERL_A) .libs/libperl_orig.a; \
+	fi
+
+.libs/DynaLoader.a:
+	@if [ ! -d .libs ]; then mkdir .libs; fi
+	@rm -f .libs/DynaLoader.a
+	@if [ x$(DYNALOADER_H) = x ]; then \
+		touch .libs/DynaLoader.a; \
+	else \
+		$(LN_S) $(DYNALOADER_A) .libs/DynaLoader.a; \
+	fi
+
+common_sources = \
+	common/Accounts.xs \
+	common/Gaim.xs \
+	common/Gaim.pm \
+	common/Makefile.PL.in \
+	common/typemap \
+	common/module.h
+
+EXTRA_DIST = \
+	Makefile.mingw \
+	$(common_sources)
+
+all-local:
+	@for dir in $(perl_dirs); do \
+		cd $$dir && \
+		if [ ! -f Makefile ]; then \
+			$(perlpath) Makefile.PL $(PERL_MM_PARAMS); \
+		fi && \
+		($(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS) || \
+		 $(MAKE) CC="$(CC)" CCFLAGS="$(PERL_CFLAGS) $(CFLAGS)" $(PERL_EXTRA_OPTS)) && \
+		cd ..; \
+	done
+
+install-exec-local:
+	@for dir in $(perl_dirs); do \
+		cd $$dir; \
+		$(MAKE) install; \
+		cd ..; \
+	done
+
+clean-generic:
+	@for dir in $(perl_dirs); do \
+		cd $$dir; \
+		$(MAKE) clean; \
+		cd ..; \
+	done
+
+distclean-generic:
+	@for dir in $(perl_dirs); do \
+		cd $$dir; \
+		$(MAKE) realclean; \
+		rm -f Makefile.PL; \
+		cd ..; \
+	done

 AM_CPPFLAGS = \
 	-DVERSION=\"$(VERSION)\" \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/.cvsignore	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,6 @@
+*.bs
+*.o
+Makefile.PL
+blib
+pm_to_blib
+*.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/Account.xs	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,151 @@
+#include "module.h"
+
+MODULE = Gaim::Account  PACKAGE = Gaim::Account  PREFIX = gaim_account_
+PROTOTYPES: ENABLE
+
+Gaim::Connection
+gaim_account_connect(account)
+	Gaim::Account account
+
+void
+gaim_account_disconnect(account)
+	Gaim::Account account
+
+void
+gaim_account_set_username(account, username)
+	Gaim::Account account
+	const char *username
+
+void
+gaim_account_set_password(account, password)
+	Gaim::Account account
+	const char *password
+
+void
+gaim_account_set_alias(account, alias)
+	Gaim::Account account
+	const char *alias
+
+void
+gaim_account_set_user_info(account, user_info)
+	Gaim::Account account
+	const char *user_info
+
+void
+gaim_account_set_buddy_icon(account, buddy_icon)
+	Gaim::Account account
+	const char *buddy_icon
+
+void
+gaim_account_set_protocol_id(account, protocol_id)
+	Gaim::Account account
+	const char *protocol_id
+
+void
+gaim_account_set_remember_password(account, value)
+	Gaim::Account account
+	gboolean value
+
+void
+gaim_account_set_check_mail(account, value)
+	Gaim::Account account
+	gboolean value
+
+void
+gaim_account_set_auto_login(account, ui, value)
+	Gaim::Account account
+	const char *ui
+	gboolean value
+
+void
+gaim_account_set_public_ip(account, ip)
+	Gaim::Account account
+	const char *ip
+
+gboolean
+gaim_account_is_connected(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_username(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_password(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_alias(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_user_info(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_buddy_icon(account)
+	Gaim::Account account
+
+const char *
+gaim_account_get_protocol_id(account)
+	Gaim::Account account
+
+Gaim::Connection
+gaim_account_get_connection(account)
+	Gaim::Account account
+
+gboolean
+gaim_account_get_remember_password(account)
+	Gaim::Account account
+
+gboolean
+gaim_account_get_check_mail(account)
+	Gaim::Account account
+
+gboolean
+gaim_account_get_auto_login(account, ui)
+	Gaim::Account account
+	const char *ui
+
+const char *
+gaim_account_get_public_ip(account)
+	Gaim::Account account
+
+void *
+handle()
+CODE:
+	RETVAL = gaim_accounts_get_handle();
+OUTPUT:
+	RETVAL
+
+
+MODULE = Gaim::Account  PACKAGE = Gaim::Accounts  PREFIX = gaim_accounts_
+
+void
+gaim_accounts_add(account)
+	Gaim::Account account
+
+void
+gaim_accounts_remove(account)
+	Gaim::Account account
+
+
+MODULE = Gaim::Account  PACKAGE = Gaim
+
+void
+accounts()
+PREINIT:
+	GList *l;
+PPCODE:
+	for (l = gaim_accounts_get_all(); l != NULL; l = l->next)
+		XPUSHs(sv_2mortal(gaim_perl_bless_object(l->data, "Gaim::Account")));
+
+Gaim::Account
+account_find(name, protocol_id)
+	const char *name
+	const char *protocol_id
+CODE:
+	RETVAL = gaim_accounts_find_with_prpl_id(name, protocol_id);
+OUTPUT:
+	RETVAL
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/Gaim.pm	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,91 @@
+package Gaim;
+
+use 5.008;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration	use Gaim ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+
+);
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Gaim', $VERSION);
+
+# Preloaded methods go here.
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Gaim - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Gaim;
+  blah blah blah
+
+=head1 ABSTRACT
+
+  This should be the abstract for Gaim.
+  The abstract is used when making PPD (Perl Package Description) files.
+  If you don't want an ABSTRACT you should also edit Makefile.PL to
+  remove the ABSTRACT_FROM option.
+
+=head1 DESCRIPTION
+
+Stub documentation for Gaim, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Christian Hammond, E<lt>chipx86@localdomainE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2003 by Christian Hammond
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/Gaim.xs	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,13 @@
+#include "module.h"
+
+MODULE = Gaim  PACKAGE = Gaim
+PROTOTYPES: ENABLE
+
+void
+debug(string)
+	const char *string
+CODE:
+	gaim_debug(GAIM_DEBUG_INFO, "perl script", string);
+
+BOOT:
+	GAIM_PERL_BOOT(Account);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/Makefile.PL.in	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,16 @@
+use 5.008;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Gaim',
+    'VERSION_FROM'	=> 'Gaim.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'Gaim.pm', # retrieve abstract from module
+       AUTHOR     => 'Christian Hammond <chipx86@gnupdate.org>') : ()),
+    'LIBS'		=> [''], # e.g., '-lm'
+    'DEFINE'		=> '', # e.g., '-DHAVE_SOMETHING'
+    'INC'		=> '-I. -I@top_srcdir@ -I@top_srcdir@/src @GLIB_CFLAGS@', # e.g., '-I. -I/usr/include/other'
+    'OBJECT'		=> '$(O_FILES)', # link all the C files too
+);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/common.h	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,4 @@
+#ifndef _GAIM_PERL_COMMON_H_
+#define _GAIM_PERL_COMMON_H_
+
+#endif /* _GAIM_PERL_COMMON_H_ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/module.h	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,19 @@
+typedef struct group *Gaim__Group;
+
+#define group perl_group
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+#include <glib.h>
+
+#undef group
+
+#include "../perl-common.h"
+
+#include "account.h"
+#include "connection.h"
+#include "debug.h"
+
+typedef GaimAccount *Gaim__Account;
+typedef GaimConnection *Gaim__Connection;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/typemap	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,15 @@
+TYPEMAP
+gboolean            T_BOOL
+Gaim::Account       T_GaimObj
+Gaim::Connection    T_GaimObj
+
+INPUT
+
+T_GaimObj
+	$var = gaim_perl_ref_object($arg)
+
+
+OUTPUT
+
+T_GaimObj
+	$arg = gaim_perl_bless_object($var, "\$type\");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/perl-common.c	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,107 @@
+#include <XSUB.h>
+#include <EXTERN.h>
+#include <perl.h>
+#include <glib.h>
+
+#include "perl-common.h"
+
+extern PerlInterpreter *my_perl;
+
+static GHashTable *object_stashes = NULL;
+
+static int
+magic_free_object(pTHX_ SV *sv, MAGIC *mg)
+{
+	sv_setiv(sv, 0);
+
+	return 0;
+}
+
+static MGVTBL vtbl_free_object =
+{
+	NULL, NULL, NULL, NULL, magic_free_object
+};
+
+static SV *
+create_sv_ptr(void *object)
+{
+	SV *sv;
+
+	sv = newSViv((IV)object);
+
+	sv_magic(sv, NULL, '~', NULL, 0);
+
+	SvMAGIC(sv)->mg_private = 0x1551; /* HF */
+	SvMAGIC(sv)->mg_virtual = &vtbl_free_object;
+
+	return sv;
+}
+
+SV *
+gaim_perl_bless_object(void *object, const char *stash_name)
+{
+	HV *stash;
+	HV *hv;
+	void *hash;
+
+	if (object_stashes == NULL)
+	{
+		object_stashes = g_hash_table_new(g_direct_hash, g_direct_equal);
+	}
+
+	stash = gv_stashpv(stash_name, 1);
+
+	hv = newHV();
+	hv_store(hv, "_gaim", 5, create_sv_ptr(object), 0);
+
+	return sv_bless(newRV_noinc((SV *)hv), stash);
+
+//	return sv_bless(create_sv_ptr(object), gv_stashpv(stash, 1));
+//	return create_sv_ptr(object);
+
+//	dXSARGS;
+
+//	return sv_setref_pv(ST(0), "Gaim::Account", create_sv_ptr(object));
+}
+
+gboolean
+gaim_perl_is_ref_object(SV *o)
+{
+	SV **sv;
+	HV *hv;
+
+	hv = hvref(o);
+
+	if (hv != NULL)
+	{
+		sv = hv_fetch(hv, "_gaim", 5, 0);
+
+		if (sv != NULL)
+			return TRUE;
+	}
+
+	return FALSE;
+}
+
+void *
+gaim_perl_ref_object(SV *o)
+{
+	SV **sv;
+	HV *hv;
+	void *p;
+
+	hv = hvref(o);
+
+	if (hv == NULL)
+		return NULL;
+
+	sv = hv_fetch(hv, "_gaim", 5, 0);
+
+	if (sv == NULL)
+		croak("variable is damaged");
+
+	p = GINT_TO_POINTER(SvIV(*sv));
+
+	return p;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/perl-common.h	Tue Aug 19 21:47:36 2003 +0000
@@ -0,0 +1,29 @@
+#ifndef _GAIM_PERL_COMMON_H_
+#define _GAIM_PERL_COMMON_H_
+
+//#define plain_bless(object, stash) \
+//	sv_bless(sv_setref_pv(newRV((object))))
+
+//#define plain_bless(object, stash) \
+//	((object) == NULL ? &PL_sv_undef : \
+//	gaim_perl_bless_plain((stash), (object)))
+
+#define is_hvref(o) \
+	((o) && SvROK(o) && SvRV(o) && (SvTYPE(SvRV(o)) == SVt_PVHV))
+
+#define hvref(o) \
+	(is_hvref(o) ? (HV *)SvRV(o) : NULL);
+
+#define GAIM_PERL_BOOT(x) \
+	{ \
+		extern void boot_Gaim__##x(pTHX_ CV *cv); \
+		gaim_perl_callXS(boot_Gaim__##x, cv, mark); \
+	}
+
+void gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark);
+void gaim_perl_bless_plain(const char *stash, void *object);
+SV *gaim_perl_bless_object(void *object, const char *stash);
+gboolean gaim_perl_is_ref_object(SV *o);
+void *gaim_perl_ref_object(SV *o);
+
+#endif /* _GAIM_PERL_COMMON_H_ */
--- a/plugins/perl/perl.c	Tue Aug 19 21:09:56 2003 +0000
+++ b/plugins/perl/perl.c	Tue Aug 19 21:47:36 2003 +0000
@@ -1,7 +1,7 @@
 /*
  * gaim
  *
- * Copyright (C) 1998-1999, Mark Spencer <markster@marko.net>
+ * Copyright (C) 2003 Christian Hammond <chipx86@gnupdate.org>
  *
  * 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
@@ -16,14 +16,7 @@
  * 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- *
- * This was taken almost exactly from X-Chat. The power of the GPL.
- * Translated from X-Chat to Gaim by Eric Warmenhoven.
- * Originally by Erik Scrafford <eriks@chilisoft.com>.
- * X-Chat Copyright (C) 1998 Peter Zelezny.
- *
  */
-
 #ifdef HAVE_CONFIG_H
 #include <config.h>
 #endif
@@ -34,6 +27,7 @@

 #undef PACKAGE

+
 #define group perl_group

 #ifdef _WIN32
@@ -82,78 +76,22 @@
 # undef pipe
 #endif

-#ifdef _WIN32
-#define _WIN32DEP_H_
-#endif
 #include "internal.h"
-
 #include "debug.h"
-#include "prpl.h"
-#include "notify.h"
-#include "server.h"
-#include "sound.h"
-
-/* XXX CORE/UI */
-#include "gtkinternal.h"
-#include "ui.h"
-
-#ifndef call_pv
-# define call_pv(i,j) perl_call_pv((i), (j))
-#endif
+#include "plugin.h"

 #define PERL_PLUGIN_ID "core-perl"

-struct perlscript {
-	char *name;
-	char *version;
-	char *shutdowncallback; /* bleh */
-	GaimPlugin *plug;
-};
-
-struct _perl_event_handlers {
-	char *event_type;
-	char *handler_name;
-	GaimPlugin *plug;
-};
-
-struct _perl_timeout_handlers {
-	char *handler_name;
-	char *handler_args;
-	gint iotag;
-	GaimPlugin *plug;
-};
+typedef struct
+{
+	GaimPlugin *plugin;
+	char *load_sub;
+	char *unload_sub;

-static GaimPlugin *my_plugin = NULL;
-static GList *perl_list = NULL;
-static GList *perl_timeout_handlers = NULL;
-static GList *perl_event_handlers = NULL;
-static PerlInterpreter *my_perl = NULL;
-static void perl_init();
-
-/* dealing with gaim */
-XS(XS_GAIM_register); /* set up hooks for script */
-XS(XS_GAIM_get_info); /* version, last to attempt signon, protocol */
-XS(XS_GAIM_print); /* lemme figure this one out... */
-XS(XS_GAIM_write_to_conv); /* write into conversation window */
+} GaimPerlScript;

-/* list stuff */
-XS(XS_GAIM_buddy_list); /* all buddies */
-XS(XS_GAIM_online_list); /* online buddies */

-/* server stuff */
-XS(XS_GAIM_command); /* send command to server */
-XS(XS_GAIM_user_info); /* given name, return struct buddy members */
-XS(XS_GAIM_print_to_conv); /* send message to someone */
-XS(XS_GAIM_print_to_chat); /* send message to chat room */
-XS(XS_GAIM_serv_send_im); /* send message to someone (but do not display) */
-
-/* handler commands */
-XS(XS_GAIM_add_event_handler); /* when servers talk */
-XS(XS_GAIM_remove_event_handler); /* remove a handler */
-XS(XS_GAIM_add_timeout_handler); /* figure it out */
-
-/* play sound */
-XS(XS_GAIM_play_sound); /*play a sound */
+PerlInterpreter *my_perl = NULL;

 static void
 #ifdef OLD_PERL
@@ -167,115 +105,60 @@
 	/* This one allows dynamic loading of perl modules in perl
            scripts by the 'use perlmod;' construction*/
 	newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-
-	/* load up all the custom Gaim perl functions */
-	newXS ("GAIM::register", XS_GAIM_register, "GAIM");
-	newXS ("GAIM::get_info", XS_GAIM_get_info, "GAIM");
-	newXS ("GAIM::print", XS_GAIM_print, "GAIM");
-	newXS ("GAIM::write_to_conv", XS_GAIM_write_to_conv, "GAIM");
-
-	newXS ("GAIM::buddy_list", XS_GAIM_buddy_list, "GAIM");
-	newXS ("GAIM::online_list", XS_GAIM_online_list, "GAIM");
-
-	newXS ("GAIM::command", XS_GAIM_command, "GAIM");
-	newXS ("GAIM::user_info", XS_GAIM_user_info, "GAIM");
-	newXS ("GAIM::print_to_conv", XS_GAIM_print_to_conv, "GAIM");
-	newXS ("GAIM::print_to_chat", XS_GAIM_print_to_chat, "GAIM");
-	newXS ("GAIM::serv_send_im", XS_GAIM_serv_send_im, "GAIM");
-
-	newXS ("GAIM::add_event_handler", XS_GAIM_add_event_handler, "GAIM");
-	newXS ("GAIM::remove_event_handler", XS_GAIM_remove_event_handler, "GAIM");
-	newXS ("GAIM::add_timeout_handler", XS_GAIM_add_timeout_handler, "GAIM");
-
-	newXS ("GAIM::play_sound", XS_GAIM_play_sound, "GAIM");
 }

-#if 0
-#define COMPARE_EVENT(evt, sig, h) \
-	if (!strcmp(event_name, (evt))) \
-	{ \
-		*signal_name = (sig); \
-		*handle = (h); \
-		return TRUE; \
-	}
-
-static gboolean
-convert_event_to_signal(const char *event_name, const char **signal_name,
-						void **handle)
-{
-	void *conn_handle    = gaim_connections_get_handle();
-	void *account_handle = gaim_accounts_get_handle();
-	void *conv_handle    = gaim_conversations_get_handle();
-	void *blist_handle   = gaim_get_blist();
-
-	COMPARE_EVENT("event_signon",  "signed-on",   conn_handle);
-	COMPARE_EVENT("event_signoff", "signed-off",  conn_handle);
-
-	COMPARE_EVENT("event_away",       "account-away",       account_handle);
-	COMPARE_EVENT("event_back",       "account-back",       account_handle);
-	COMPARE_EVENT("event_warned",     "account-warned",     account_handle);
-	COMPARE_EVENT("event_set_info",   "account-set-info",   account_handle);
-	COMPARE_EVENT("event_connecting", "account-connecting", account_handle);

-	COMPARE_EVENT("event_im_recv",          "received-im-msg",   conv_handle);
-	COMPARE_EVENT("event_im_send",          "sent-im-msg",       conv_handle);
-	COMPARE_EVENT("event_chat_invited",     "chat-invited",      conv_handle);
-	COMPARE_EVENT("event_chat_join",        "chat-joined",       conv_handle);
-	COMPARE_EVENT("event_chat_leave",       "chat-left",         conv_handle);
-	COMPARE_EVENT("event_chat_buddy_join",  "chat-buddy-joined", conv_handle);
-	COMPARE_EVENT("event_chat_buddy_leave", "chat-buddy-left",   conv_handle);
-	COMPARE_EVENT("event_chat_recv",        "received-chat-msg", conv_handle);
-	COMPARE_EVENT("event_chat_send",        "sent-chat-msg",     conv_handle);
-	COMPARE_EVENT("event_new_conversation", "conversation-created",
-				  conv_handle);
-	COMPARE_EVENT("event_im_displayed_sent", "sending-im-msg", conv_handle);
-	COMPARE_EVENT("event_im_displayed_rcvd", NULL, NULL);
-	COMPARE_EVENT("event_chat_send_invite", "chat-inviting-user", conv_handle);
-	COMPARE_EVENT("event_got_typing", "buddy-typing", conv_handle);
-	COMPARE_EVENT("event_del_conversation", "deleting-conversation",
-				  conv_handle);
-	COMPARE_EVENT("event_conversation_switch", "conversation-switched",
-				  conv_handle);
+static void
+perl_init(void)
+{
+	/* changed the name of the variable from load_file to
+	   perl_definitions since now it does much more than defining
+	   the load_file sub. Moreover, deplaced the initialisation to
+	   the xs_init function. (TheHobbit)*/
+	char *perl_args[] = { "", "-e", "0", "-w" };
+	char perl_definitions[] =
+	{
+		/* We use to function one to load a file the other to
+		   execute the string obtained from the first and holding
+		   the file conents. This allows to have a realy local $/
+		   without introducing temp variables to hold the old
+		   value. Just a question of style:) */
+		"sub load_file{"
+		  "my $f_name=shift;"
+		  "local $/=undef;"
+		  "open FH,$f_name or return \"__FAILED__\";"
+		  "$_=<FH>;"
+		  "close FH;"
+		  "return $_;"
+		"}"
+		"sub load_n_eval{"
+		  "my $f_name=shift;"
+		  "my $strin=load_file($f_name);"
+		  "return 2 if($strin eq \"__FAILED__\");"
+		  "eval $strin;"
+		  "if($@){"
+		    /*"  #something went wrong\n"*/
+		    "GAIM::print(\"Errors loading file $f_name:\\n\",\"$@\");"
+		    "return 1;"
+		  "}"
+		  "return 0;"
+		"}"
+	};

-	COMPARE_EVENT("event_buddy_signon",  "buddy-signed-on",  blist_handle);
-	COMPARE_EVENT("event_buddy_signoff", "buddy-signed-off", blist_handle);
-	COMPARE_EVENT("event_buddy_away",    "buddy-away",       blist_handle);
-	COMPARE_EVENT("event_buddy_back",    "buddy-back",       blist_handle);
-	COMPARE_EVENT("event_buddy_idle",    "buddy-idle",       blist_handle);
-	COMPARE_EVENT("event_buddy_unidle",  "buddy-unidle",     blist_handle);
-	COMPARE_EVENT("event_blist_update",  "update-idle",      blist_handle);
-
-	COMPARE_EVENT("event_quit", "quitting", gaim_get_core());
-
-	*signal_name = NULL;
-	*handle = NULL;
-
-	return FALSE;
-}
+	my_perl = perl_alloc();
+	perl_construct(my_perl);
+#ifdef DEBUG
+	perl_parse(my_perl, xs_init, 4, perl_args, NULL);
+#else
+	perl_parse(my_perl, xs_init, 3, perl_args, NULL);
+#endif
+#ifdef HAVE_PERL_EVAL_PV
+	eval_pv(perl_definitions, TRUE);
+#else
+	perl_eval_pv(perl_definitions, TRUE); /* deprecated */
 #endif

-static char *
-escape_quotes(const char *buf)
-{
-	static char *tmp_buf = NULL;
-	const char *i;
-	char *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;
+	perl_run(my_perl);
 }

 /*
@@ -395,182 +278,8 @@
 }

 static void
-perl_unload_file(GaimPlugin *plug)
-{
-	char *atmp[2] = { "", NULL };
-	struct perlscript *scp = NULL;
-	struct _perl_timeout_handlers *thn;
-	struct _perl_event_handlers *ehn;
-	GList *pl;
-
-	for (pl = perl_list; pl != NULL; pl = pl->next) {
-		scp = pl->data;
-
-		if (scp->plug == plug) {
-			perl_list = g_list_remove(perl_list, scp);
-
-			if (scp->shutdowncallback[0])
-				execute_perl(scp->shutdowncallback, 1, atmp);
-
-			g_free(scp->name);
-			g_free(scp->version);
-			g_free(scp->shutdowncallback);
-			g_free(scp);
-
-			break;
-		}
-	}
-
-	for (pl = perl_timeout_handlers; pl != NULL; pl = pl->next) {
-		thn = pl->data;
-
-		if (thn && thn->plug == plug) {
-			perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn);
-
-			g_source_remove(thn->iotag);
-			g_free(thn->handler_args);
-			g_free(thn->handler_name);
-			g_free(thn);
-		}
-	}
-
-	for (pl = perl_event_handlers; pl != NULL; pl = pl->next) {
-		ehn = pl->data;
-
-		if (ehn && ehn->plug == plug) {
-			perl_event_handlers = g_list_remove(perl_event_handlers, ehn);
-
-			g_free(ehn->event_type);
-			g_free(ehn->handler_name);
-			g_free(ehn);
-		}
-	}
-}
-
-static int
-perl_load_file(char *script_name, GaimPlugin *plugin)
-{
-	char *atmp[2] = { script_name, NULL };
-	GList *s;
-	struct perlscript *scp;
-	int ret;
-
-	if (my_perl == NULL)
-		perl_init();
-
-	plugin->handle = plugin->path;
-
-	ret = execute_perl("load_n_eval", 1, atmp);
-
-	for (s = perl_list; s != NULL; s = s->next) {
-		scp = s->data;
-
-		if (!strcmp(scp->name, plugin->info->name) &&
-		    !strcmp(scp->version, plugin->info->version)) {
-
-			break;
-		}
-	}
-
-	if (!s) {
-		plugin->error = g_strdup(_("GAIM::register not called with "
-								   "proper arguments.  Consult PERL-HOWTO."));
-
-		return 0;
-	}
-
-	return ret;
-}
-
-static void
-perl_init(void)
-{
-	/* changed the name of the variable from load_file to
-	   perl_definitions since now it does much more than defining
-	   the load_file sub. Moreover, deplaced the initialisation to
-	   the xs_init function. (TheHobbit)*/
-	char *perl_args[] = { "", "-e", "0", "-w" };
-	char perl_definitions[] =
-	{
-		/* We use to function one to load a file the other to
-		   execute the string obtained from the first and holding
-		   the file conents. This allows to have a realy local $/
-		   without introducing temp variables to hold the old
-		   value. Just a question of style:) */
-		"sub load_file{"
-		  "my $f_name=shift;"
-		  "local $/=undef;"
-		  "open FH,$f_name or return \"__FAILED__\";"
-		  "$_=<FH>;"
-		  "close FH;"
-		  "return $_;"
-		"}"
-		"sub load_n_eval{"
-		  "my $f_name=shift;"
-		  "my $strin=load_file($f_name);"
-		  "return 2 if($strin eq \"__FAILED__\");"
-		  "eval $strin;"
-		  "if($@){"
-		    /*"  #something went wrong\n"*/
-		    "GAIM::print(\"Errors loading file $f_name:\\n\",\"$@\");"
-		    "return 1;"
-		  "}"
-		  "return 0;"
-		"}"
-	};
-
-	my_perl = perl_alloc();
-	perl_construct(my_perl);
-#ifdef DEBUG
-	perl_parse(my_perl, xs_init, 4, perl_args, NULL);
-#else
-	perl_parse(my_perl, xs_init, 3, perl_args, NULL);
-#endif
-#ifdef HAVE_PERL_EVAL_PV
-	eval_pv(perl_definitions, TRUE);
-#else
-	perl_eval_pv(perl_definitions, TRUE); /* deprecated */
-#endif
-}
-
-static void
 perl_end(void)
 {
-	char *atmp[2] = { "", NULL };
-	struct perlscript *scp;
-	struct _perl_timeout_handlers *thn;
-	struct _perl_event_handlers *ehn;
-
-	while (perl_list) {
-		scp = perl_list->data;
-		perl_list = g_list_remove(perl_list, scp);
-
-		if (scp->shutdowncallback[0])
-			execute_perl(scp->shutdowncallback, 1, atmp);
-
-		g_free(scp->name);
-		g_free(scp->version);
-		g_free(scp->shutdowncallback);
-		g_free(scp);
-	}
-
-	while (perl_timeout_handlers) {
-		thn = perl_timeout_handlers->data;
-		perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn);
-		g_source_remove(thn->iotag);
-		g_free(thn->handler_args);
-		g_free(thn->handler_name);
-		g_free(thn);
-	}
-
-	while (perl_event_handlers) {
-		ehn = perl_event_handlers->data;
-		perl_event_handlers = g_list_remove(perl_event_handlers, ehn);
-		g_free(ehn->event_type);
-		g_free(ehn->handler_name);
-		g_free(ehn);
-	}
-
 	if (my_perl != NULL) {
 		perl_destruct(my_perl);
 		perl_free(my_perl);
@@ -578,775 +287,15 @@
 	}
 }

-XS (XS_GAIM_register)
-{
-	char *name, *ver, *callback, *unused; /* exactly like X-Chat, eh? :) */
-	unsigned int junk;
-	struct perlscript *scp;
-	GaimPlugin *plug = NULL;
-	GList *pl;
-
-	dXSARGS;
-	items = 0;
-
-	name     = SvPV(ST(0), junk);
-	ver      = SvPV(ST(1), junk);
-	callback = SvPV(ST(2), junk);
-	unused   = SvPV(ST(3), junk);
-
-	gaim_debug(GAIM_DEBUG_INFO, "perl",
-			   "GAIM::register(%s, %s)\n", name, ver);
-
-	for (pl = gaim_plugins_get_all(); pl != NULL; pl = pl->next) {
-		plug = pl->data;
-
-		if (!strcmp(name, plug->info->name) &&
-		    !strcmp(ver, plug->info->version)) {
-
-			break;
-		}
-
-		plug = NULL;
-	}
-
-	if (plug) {
-		scp = g_new0(struct perlscript, 1);
-		scp->name = g_strdup(name);
-		scp->version = g_strdup(ver);
-		scp->shutdowncallback = g_strdup(callback);
-		scp->plug = plug;
-		perl_list = g_list_append(perl_list, scp);
-		XST_mPV(0, plug->path);
-	}
-	else
-		XST_mPV(0, NULL);
-
-	XSRETURN (1);
-}
-
-XS (XS_GAIM_get_info)
-{
-	int i = 0;
-	dXSARGS;
-	items = 0;
-
-	switch(SvIV(ST(0))) {
-		case 0:
-			XST_mPV(0, VERSION);
-			i = 1;
-			break;
-
-		case 1:
-			{
-				GList *c = gaim_connections_get_all();
-				GaimConnection *gc;
-
-				while (c) {
-					gc = (GaimConnection *)c->data;
-					XST_mIV(i++, (guint)gc);
-					c = c->next;
-				}
-			}
-			break;
-
-		case 2:
-			{
-				GaimConnection *gc =
-					(GaimConnection *)SvIV(ST(1));
-				GaimAccount *account = gaim_connection_get_account(gc);
-
-				if (g_list_find(gaim_connections_get_all(), gc))
-					XST_mIV(i++, gaim_account_get_protocol(account));
-				else
-					XST_mIV(i++, -1);
-			}
-			break;
-
-		case 3:
-			{
-				GaimConnection *gc =
-					(GaimConnection *)SvIV(ST(1));
-				GaimAccount *account = gaim_connection_get_account(gc);
-
-				if (g_list_find(gaim_connections_get_all(), gc))
-					XST_mPV(i++, gaim_account_get_username(account));
-				else
-					XST_mPV(i++, "");
-			}
-			break;
-
-		case 4:
-			{
-				GaimConnection *gc =
-					(GaimConnection *)SvIV(ST(1));
-				GaimAccount *account = gaim_connection_get_account(gc);
-
-				if (g_list_find(gaim_connections_get_all(), gc))
-					XST_mIV(i++, g_list_index(gaim_accounts_get_all(),
-											  account));
-				else
-					XST_mIV(i++, -1);
-			}
-			break;
-
-		case 5:
-			{
-				GList *a = gaim_accounts_get_all();
-				while (a) {
-					GaimAccount *account = a->data;
-					XST_mPV(i++, gaim_account_get_username(account));
-					a = a->next;
-				}
-			}
-			break;
-
-		case 6:
-			{
-				GList *a = gaim_accounts_get_all();
-				while (a) {
-					GaimAccount *account = a->data;
-					XST_mIV(i++, gaim_account_get_protocol(account));
-					a = a->next;
-				}
-			}
-			break;
-
-		case 7:
-			{
-				GaimConnection *gc =
-					(GaimConnection *)SvIV(ST(1));
-
-				if (g_list_find(gaim_connections_get_all(), gc))
-					XST_mPV(i++, gc->prpl->info->name);
-				else
-					XST_mPV(i++, "Unknown");
-			}
-			break;
-
-		default:
-			XST_mPV(0, "Error2");
-			i = 1;
-	}
-
-	XSRETURN(i);
-}
-
-XS (XS_GAIM_print)
-{
-	char *title;
-	char *message;
-	unsigned int junk;
-	dXSARGS;
-	items = 0;
-
-	title = SvPV(ST(0), junk);
-	message = SvPV(ST(1), junk);
-	gaim_notify_info(my_plugin, NULL, title, message);
-	XSRETURN(0);
-}
-
-XS (XS_GAIM_buddy_list)
+void
+gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark)
 {
-	GaimConnection *gc;
-	struct buddy *buddy;
-	struct group *g;
-	GaimBlistNode *gnode,*bnode;
-	int i = 0;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-
-	for(gnode = gaim_get_blist()->root; gnode; gnode = gnode->next) {
-		if(!GAIM_BLIST_NODE_IS_GROUP(gnode))
-			continue;
-		g = (struct group *)gnode;
-		for(bnode = gnode->child; bnode; bnode = bnode->next) {
-			if(!GAIM_BLIST_NODE_IS_BUDDY(bnode))
-				continue;
-			buddy = (struct buddy *)bnode;
-			if(buddy->account == gc->account)
-				XST_mPV(i++, buddy->name);
-		}
-	}
-	XSRETURN(i);
-}
-
-XS (XS_GAIM_online_list)
-{
-	GaimConnection *gc;
-	struct buddy *b;
-	struct group *g;
-	GaimBlistNode *gnode,*bnode;
-	int i = 0;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-
-	for(gnode = gaim_get_blist()->root; gnode; gnode = gnode->next) {
-		if(!GAIM_BLIST_NODE_IS_GROUP(gnode))
-			continue;
-		g = (struct group *)gnode;
-		for(bnode = gnode->child; bnode; bnode = bnode->next) {
-			if(!GAIM_BLIST_NODE_IS_BUDDY(bnode))
-				continue;
-			b = (struct buddy *)bnode;
-			if (b->account == gc->account && GAIM_BUDDY_IS_ONLINE(b)) XST_mPV(i++, b->name);
-		}
-	}
-	XSRETURN(i);
-}
-
-XS (XS_GAIM_command)
-{
-	unsigned int junk;
-	char *command = NULL;
-	dXSARGS;
-	items = 0;
-
-	command = SvPV(ST(0), junk);
-	if (!command) XSRETURN(0);
-	if (!strncasecmp(command, "signon", 6)) {
-		int index = SvIV(ST(1));
-		if (g_list_nth_data(gaim_accounts_get_all(), index))
-		gaim_account_connect(g_list_nth_data(gaim_accounts_get_all(), index));
-	} else if (!strncasecmp(command, "signoff", 7)) {
-		GaimConnection *gc = (GaimConnection *)SvIV(ST(1));
-		if (g_list_find(gaim_connections_get_all(), gc))
-			gaim_connection_disconnect(gc);
-		else
-			gaim_connections_disconnect_all();
-	} else if (!strncasecmp(command, "info", 4)) {
-		GaimConnection *gc = (GaimConnection *)SvIV(ST(1));
-		if (g_list_find(gaim_connections_get_all(), gc))
-			serv_set_info(gc, SvPV(ST(2), junk));
-	} else if (!strncasecmp(command, "away", 4)) {
-		char *message = SvPV(ST(1), junk);
-		static struct away_message a;
-		g_snprintf(a.message, sizeof(a.message), "%s", message);
-		do_away_message(NULL, &a);
-	} else if (!strncasecmp(command, "back", 4)) {
-		do_im_back(NULL, NULL);
-	} else if (!strncasecmp(command, "idle", 4)) {
-		GList *c = gaim_connections_get_all();
-		GaimConnection *gc;
-
-		while (c) {
-			gc = (GaimConnection *)c->data;
-			serv_set_idle(gc, SvIV(ST(1)));
-			c = c->next;
-		}
-	} else if (!strncasecmp(command, "warn", 4)) {
-		GList *c = gaim_connections_get_all();
-		GaimConnection *gc;
-
-		while (c) {
-			gc = (GaimConnection *)c->data;
-			serv_warn(gc, SvPV(ST(1), junk), SvIV(ST(2)));
-			c = c->next;
-		}
-	}
-
-	XSRETURN(0);
-}
-
-XS (XS_GAIM_user_info)
-{
-	GaimConnection *gc;
-	unsigned int junk;
-	struct buddy *buddy = NULL;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-	if (g_list_find(gaim_connections_get_all(), gc))
-		buddy = gaim_find_buddy(gc->account, SvPV(ST(1), junk));
-
-	if (!buddy)
-		XSRETURN(0);
-	XST_mPV(0, buddy->name);
-	XST_mPV(1, gaim_get_buddy_alias(buddy));
-	XST_mPV(2, GAIM_BUDDY_IS_ONLINE(buddy) ? "Online" : "Offline");
-	XST_mIV(3, buddy->evil);
-	XST_mIV(4, buddy->signon);
-	XST_mIV(5, buddy->idle);
-	XSRETURN(6);
-}
-
-XS (XS_GAIM_write_to_conv)
-{
-	char *nick, *who, *what;
-	GaimConversation *c;
-	int junk;
-	int send, wflags;
-	dXSARGS;
-	items = 0;
-
-	nick = SvPV(ST(0), junk);
-	send = SvIV(ST(1));
-	what = SvPV(ST(2), junk);
-	who = SvPV(ST(3), junk);
-
-	if (!*who) who=NULL;
-
-	switch (send) {
-		case 0: wflags=WFLAG_SEND; break;
-		case 1: wflags=WFLAG_RECV; break;
-		case 2: wflags=WFLAG_SYSTEM; break;
-		default: wflags=WFLAG_RECV;
-	}
-
-	c = gaim_find_conversation(nick);
-
-	if (!c)
-		c = gaim_conversation_new(GAIM_CONV_IM, NULL, nick);
-
-	gaim_conversation_write(c, who, what, -1, wflags, time(NULL));
-	XSRETURN(0);
-}
-
-XS (XS_GAIM_serv_send_im)
-{
-	GaimConnection *gc;
-	char *nick, *what;
-	int isauto;
-	int junk;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-	nick = SvPV(ST(1), junk);
-	what = SvPV(ST(2), junk);
-	isauto = SvIV(ST(3));
-
-	if (!g_list_find(gaim_connections_get_all(), gc)) {
-		XSRETURN(0);
-		return;
-	}
-	serv_send_im(gc, nick, what, -1, isauto);
-	XSRETURN(0);
-}
-
-XS (XS_GAIM_print_to_conv)
-{
-	GaimConnection *gc;
-	char *nick, *what;
-	int isauto;
-	GaimConversation *c;
-	unsigned int junk;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-	nick = SvPV(ST(1), junk);
-	what = SvPV(ST(2), junk);
-	isauto = SvIV(ST(3));
-	if (!g_list_find(gaim_connections_get_all(), gc)) {
-		XSRETURN(0);
-		return;
-	}
-
-	c = gaim_find_conversation(nick);
-
-	if (!c)
-		c = gaim_conversation_new(GAIM_CONV_IM, gc->account, nick);
-	else
-		gaim_conversation_set_account(c, gc->account);
-
-	gaim_conversation_write(c, NULL, what, -1,
-				(WFLAG_SEND | (isauto ? WFLAG_AUTO : 0)), time(NULL));
-	serv_send_im(gc, nick, what, -1, isauto ? IM_FLAG_AWAY : 0);
-	XSRETURN(0);
-}
-
-
+	dSP;

-XS (XS_GAIM_print_to_chat)
-{
-	GaimConnection *gc;
-	int id;
-	char *what;
-	GaimConversation *b = NULL;
-	GSList *bcs;
-	unsigned int junk;
-	dXSARGS;
-	items = 0;
-
-	gc = (GaimConnection *)SvIV(ST(0));
-	id = SvIV(ST(1));
-	what = SvPV(ST(2), junk);
-
-	if (!g_list_find(gaim_connections_get_all(), gc)) {
-		XSRETURN(0);
-		return;
-	}
-	bcs = gc->buddy_chats;
-	while (bcs) {
-		b = (GaimConversation *)bcs->data;
-
-		if (gaim_chat_get_id(gaim_conversation_get_chat_data(b)) == id)
-			break;
-		bcs = bcs->next;
-		b = NULL;
-	}
-	if (b)
-		serv_chat_send(gc, id, what);
-	XSRETURN(0);
-}
-
-#if 0
-static int
-perl_event(GaimEvent event, void *unused, va_list args)
-{
-	char *buf[5] = { NULL, NULL, NULL, NULL, NULL }; /* Maximum of 5 args */
-	void *arg1 = NULL, *arg2 = NULL, *arg3 = NULL, *arg4 = NULL, *arg5 = NULL;
-	char tmpbuf1[16], tmpbuf2[16], tmpbuf3[1];
-	GList *handler;
-	struct _perl_event_handlers *data;
-	int handler_return;
-
-	arg1 = va_arg(args, void *);
-	arg2 = va_arg(args, void *);
-	arg3 = va_arg(args, void *);
-	arg4 = va_arg(args, void *);
-	arg5 = va_arg(args, void *);
-
-	tmpbuf1[0] = '\0';
-	tmpbuf2[0] = '\0';
-	tmpbuf3[0] = '\0';
-
-	/* Make a pretty array of char*'s with which to call perl functions */
-	switch (event) {
-	case event_connecting:
-	case event_signon:
-	case event_signoff:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		break;
-	case event_away:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = ((GaimConnection *)arg1)->away ?
-				((GaimConnection *)arg1)->away : tmpbuf2;
-		break;
-	case event_im_recv:
-		if (!*(char**)arg2 || !*(char**)arg3) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = *(char **)arg2;
-		buf[2] = *(char **)arg3;
-		break;
-	case event_im_send:
-		if (!*(char**)arg3) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2 ? arg2 : tmpbuf3;
-		buf[2] = *(char **)arg3;
-		break;
-	case event_buddy_signon:
-	case event_buddy_signoff:
-	case event_set_info:
-	case event_buddy_away:
-	case event_buddy_back:
-	case event_buddy_idle:
-	case event_buddy_unidle:
-	case event_got_typing:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2;
-		break;
-	case event_chat_invited:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2;
-		buf[2] = arg3;
-		buf[3] = arg4;
-		break;
-	case event_chat_join:
-	case event_chat_buddy_join:
-	case event_chat_buddy_leave:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg2);
-		buf[1] = tmpbuf2;
-		buf[2] = arg3;
-		break;
-	case event_chat_leave:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg2);
-		buf[1] = tmpbuf2;
-		break;
-	case event_chat_recv:
-		if (!*(char**)arg3 || !*(char**)arg4) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg2);
-		buf[1] = tmpbuf2;
-		buf[2] = *(char **)arg3;
-		buf[3] = *(char **)arg4;
-		break;
-	case event_chat_send_invite:
-		if (!*(char**)arg4) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg2);
-		buf[1] = tmpbuf2;
-		buf[2] = arg3;
-		buf[3] = *(char **)arg4;
-		break;
-	case event_chat_send:
-		if (!*(char**)arg3) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg2);
-		buf[1] = tmpbuf2;
-		buf[2] = *(char **)arg3;
-		break;
-	case event_warned:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2 ? arg2 : tmpbuf3;
-		g_snprintf(tmpbuf2, 16, "%d", (int)arg3);
-		buf[2] = tmpbuf2;
-		break;
-	case event_quit:
-	case event_blist_update:
-		buf[0] = tmpbuf3;
-		break;
-	case event_new_conversation:
-	case event_del_conversation:
-	case event_conversation_switch:
-		buf[0] = arg1;
-		break;
-	case event_im_displayed_sent:
-		if (!*(char**)arg3) return 1;
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2;
-		buf[2] = *(char **)arg3;
-		break;
-	case event_im_displayed_rcvd:
-		g_snprintf(tmpbuf1, 16, "%lu", (unsigned long)arg1);
-		buf[0] = tmpbuf1;
-		buf[1] = arg2;
-		buf[2] = arg3 ? arg3 : tmpbuf3;
-		break;
-	case event_draw_menu:
-		/* we can't handle this usefully without gtk/perl bindings */
-		return 0;
-	default:
-		gaim_debug(GAIM_DEBUG_WARNING, "perl",
-				   "Someone forgot to handle %s in the perl binding\n",
-				   gaim_event_get_name(event));
-		return 0;
-	}
-
-	/* Call any applicable functions */
-	for (handler = perl_event_handlers;
-		 handler != NULL;
-		 handler = handler->next) {
-
-		data = handler->data;
-
-		if (!strcmp(gaim_event_get_name(event), data->event_type)) {
-
-			handler_return = execute_perl(data->handler_name, 5, buf);
+	PUSHMARK(mark);
+	(*subaddr)(aTHX_ cv);

-			if (handler_return)
-				return handler_return;
-		}
-	}
-
-	/* Now make changes from perl scripts affect the real data */
-	switch (event) {
-	case event_im_recv:
-		if (buf[1] != *(char **)arg2) {
-			free(*(char **)arg2);
-			*(char **)arg2 = buf[1];
-		}
-		if (buf[2] != *(char **)arg3) {
-			free(*(char **)arg3);
-			*(char **)arg3 = buf[2];
-		}
-		break;
-	case event_im_send:
-		if (buf[2] != *(char **)arg3) {
-			free(*(char **)arg3);
-			*(char **)arg3 = buf[2];
-		}
-		break;
-	case event_chat_recv:
-		if (buf[2] != *(char **)arg3) {
-			free(*(char **)arg3);
-			*(char **)arg3 = buf[2];
-		}
-		if (buf[3] != *(char **)arg4) {
-			free(*(char **)arg4);
-			*(char **)arg4 = buf[3];
-		}
-		break;
-	case event_chat_send_invite:
-		if (buf[3] != *(char **)arg4) {
-			free(*(char **)arg4);
-			*(char **)arg4 = buf[3];
-		}
-		break;
-	case event_chat_send:
-		if (buf[2] != *(char **)arg3) {
-			free(*(char **)arg3);
-			*(char **)arg3 = buf[2];
-		}
-		break;
-	case event_im_displayed_sent:
-		if (buf[2] != *(char **)arg3) {
-			free(*(char **)arg3);
-			*(char **)arg3 = buf[2];
-		}
-		break;
-	default:
-		break;
-	}
-
-	return 0;
-}
-#endif
-
-XS (XS_GAIM_add_event_handler)
-{
-	unsigned int junk;
-	struct _perl_event_handlers *handler;
-	char *handle;
-	GaimPlugin *plug;
-	GList *p;
-	dXSARGS;
-	items = 0;
-
-	handle = SvPV(ST(0), junk);
-
-	gaim_debug(GAIM_DEBUG_ERROR, "perl",
-			   "Ay, sorry matey. Ye perl scripts are getting "
-			   "events no more. Argh.\n");
-
-	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
-		plug = p->data;
-
-		if (!strcmp(handle, plug->path))
-			break;
-	}
-
-	if (p) {
-		handler = g_new0(struct _perl_event_handlers, 1);
-		handler->event_type = g_strdup(SvPV(ST(1), junk));
-		handler->handler_name = g_strdup(SvPV(ST(2), junk));
-		handler->plug = plug;
-		perl_event_handlers = g_list_append(perl_event_handlers, handler);
-		gaim_debug(GAIM_DEBUG_INFO, "perl",
-				   "Registered perl event handler for %s\n",
-				   handler->event_type);
-	} else {
-		gaim_debug(GAIM_DEBUG_ERROR, "perl",
-				   "Invalid handle (%s) registering perl event handler\n",
-				   handle);
-	}
-
-	XSRETURN_EMPTY;
-}
-
-XS (XS_GAIM_remove_event_handler)
-{
-	unsigned int junk;
-	struct _perl_event_handlers *ehn;
-	GList *cur = perl_event_handlers;
-	dXSARGS;
-	items = 0;
-
-	while (cur) {
-		GList *next = cur->next;
-		ehn = cur->data;
-
-		if (!strcmp(ehn->event_type, SvPV(ST(0), junk)) &&
-			!strcmp(ehn->handler_name, SvPV(ST(1), junk)))
-		{
-			perl_event_handlers = g_list_remove(perl_event_handlers, ehn);
-			g_free(ehn->event_type);
-			g_free(ehn->handler_name);
-			g_free(ehn);
-		}
-
-		cur = next;
-	}
-}
-
-static int
-perl_timeout(gpointer data)
-{
-	char *atmp[2] = { NULL, NULL };
-	struct _perl_timeout_handlers *handler = data;
-
-	atmp[0] = escape_quotes(handler->handler_args);
-	execute_perl(handler->handler_name, 1, atmp);
-
-	perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler);
-	g_free(handler->handler_args);
-	g_free(handler->handler_name);
-	g_free(handler);
-
-	return 0; /* returning zero removes the timeout handler */
-}
-
-XS (XS_GAIM_add_timeout_handler)
-{
-	unsigned int junk;
-	long timeout;
-	struct _perl_timeout_handlers *handler;
-	char *handle;
-	GaimPlugin *plug;
-	GList *p;
-
-	dXSARGS;
-	items = 0;
-
-	handle = SvPV(ST(0), junk);
-
-	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
-		plug = p->data;
-
-		if (!strcmp(handle, plug->path))
-			break;
-	}
-
-	if (p) {
-		handler = g_new0(struct _perl_timeout_handlers, 1);
-		timeout = 1000 * SvIV(ST(1));
-		gaim_debug(GAIM_DEBUG_INFO, "perl",
-				   "Adding timeout for %ld seconds.\n", timeout/1000);
-		handler->plug = plug;
-		handler->handler_name = g_strdup(SvPV(ST(2), junk));
-		handler->handler_args = g_strdup(SvPV(ST(3), junk));
-		perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler);
-		handler->iotag = g_timeout_add(timeout, perl_timeout, handler);
-	} else {
-		gaim_debug(GAIM_DEBUG_ERROR, "perl",
-				   "Invalid handle (%s) in adding perl timeout handler.",
-				   handle);
-	}
-	XSRETURN_EMPTY;
-}
-
-XS (XS_GAIM_play_sound)
-{
-	int id;
-	dXSARGS;
-
-	items = 0;
-
-	id = SvIV(ST(0));
-
-	gaim_sound_play_event(id);
-
-	XSRETURN_EMPTY;
+	PUTBACK;
 }

 static gboolean
@@ -1354,53 +303,92 @@
 {
 	/* XXX This would be much faster if I didn't create a new
 	 *     PerlInterpreter every time I probed a plugin */
-
-	GaimPluginInfo *info;
 	PerlInterpreter *prober = perl_alloc();
 	char *argv[] = {"", plugin->path };
 	int count;
 	gboolean status = TRUE;
+	HV *plugin_info;

 	perl_construct(prober);
 	perl_parse(prober, xs_init, 2, argv, NULL);
+	perl_run(prober);

+	plugin_info = perl_get_hv("PLUGIN_INFO", FALSE);
+
+	if (plugin_info == NULL)
+		status = FALSE;
+	else if (!hv_exists(plugin_info, "perl_api_version",
+						strlen("perl_api_version")) ||
+			 !hv_exists(plugin_info, "name", strlen("name")) ||
+			 !hv_exists(plugin_info, "load", strlen("load")))
 	{
-		dSP;
-		ENTER;
-		SAVETMPS;
-		PUSHMARK(SP);
+		/* Not a valid plugin. */
+
+		status = FALSE;
+	}
+	else
+	{
+		SV **key;
+		int perl_api_ver;

-		count = perl_call_pv("description", G_NOARGS | G_ARRAY | G_EVAL);
-		SPAGAIN;
+		key = hv_fetch(plugin_info, "perl_api_version",
+					   strlen("perl_api_version"), 0);
+
+		perl_api_ver = SvIV(*key);

-		if (count == 6) {
-			info = g_new0(GaimPluginInfo, 1);
+		if (perl_api_ver != 2)
+			status = FALSE;
+		else
+		{
+			GaimPluginInfo *info;
+			GaimPerlScript *gps;
+			int len;

-			info->api_version  = 2;
-			info->type         = GAIM_PLUGIN_STANDARD;
+			gaim_debug(GAIM_DEBUG_INFO, "perl", "Found plugin info\n");
+
+			info = g_new0(GaimPluginInfo, 1);
+			gps  = g_new0(GaimPerlScript, 1);
+
+			info->api_version = 2;
+			info->type = GAIM_PLUGIN_STANDARD;

 			info->dependencies = g_list_append(info->dependencies,
 											   PERL_PLUGIN_ID);

-			POPp; /* iconfile */
+			gps->plugin = plugin;
+
+			/* We know this one exists. */
+			key = hv_fetch(plugin_info, "name", strlen("name"), 0);
+			info->name = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0)))
+				info->homepage = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0)))
+				info->author = g_strdup(SvPV(*key, len));

-			info->homepage    = g_strdup(POPp);
-			info->author      = g_strdup(POPp);
-			info->description = g_strdup(POPp);
-			info->version     = g_strdup(POPp);
-			info->name        = g_strdup(POPp);
+			if ((key = hv_fetch(plugin_info, "summary",
+								strlen("summary"), 0)))
+				info->summary = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "description",
+								strlen("description"), 0)))
+				info->description = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "version", strlen("version"), 0)))
+				info->version = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "load", strlen("load"), 0)))
+				gps->load_sub = g_strdup(SvPV(*key, len));
+
+			if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0)))
+				gps->unload_sub = g_strdup(SvPV(*key, len));

 			plugin->info = info;
+			info->extra_info = gps;

-			if (!gaim_plugin_register(plugin))
-				status = FALSE;
+			status = gaim_plugin_register(plugin);
 		}
-		else
-			status = FALSE;
-
-		PUTBACK;
-		FREETMPS;
-		LEAVE;
 	}

 	perl_destruct(prober);
@@ -1412,7 +400,40 @@
 static gboolean
 load_perl_plugin(GaimPlugin *plugin)
 {
-	perl_load_file(plugin->path, plugin);
+	GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info;
+	char *atmp[2] = { plugin->path, NULL };
+
+	if (gps == NULL || gps->load_sub == NULL)
+		return FALSE;
+
+	gaim_debug(GAIM_DEBUG_INFO, "perl", "Loading perl script\n");
+
+	if (my_perl == NULL)
+		perl_init();
+
+	plugin->handle = plugin->path;
+
+	execute_perl("load_n_eval", 1, atmp);
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(SP);
+
+	perl_call_pv(gps->load_sub, G_NOARGS | G_EVAL | G_SCALAR);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		int len;
+
+		gaim_debug(GAIM_DEBUG_ERROR, "perl",
+				   "Perl function %s exited abnormally: %s\n",
+				   gps->load_sub, SvPV(ERRSV, len));
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;

 	return TRUE;
 }
@@ -1420,7 +441,35 @@
 static gboolean
 unload_perl_plugin(GaimPlugin *plugin)
 {
-	perl_unload_file(plugin);
+	GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info;
+
+	if (gps == NULL || gps->unload_sub == NULL)
+		return FALSE;
+
+	gaim_debug(GAIM_DEBUG_INFO, "perl", "Unloading perl script\n");
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(SP);
+
+	perl_call_pv(gps->unload_sub, G_NOARGS | G_EVAL | G_SCALAR);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		int len;
+
+		gaim_debug(GAIM_DEBUG_ERROR, "perl",
+				   "Perl function %s exited abnormally: %s\n",
+				   gps->load_sub, SvPV(ERRSV, len));
+	}
+
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	gaim_signals_disconnect_by_handle(plugin);

 	return TRUE;
 }
@@ -1428,12 +477,41 @@
 static void
 destroy_perl_plugin(GaimPlugin *plugin)
 {
-	if (plugin->info != NULL) {
-		g_free(plugin->info->name);
-		g_free(plugin->info->version);
-		g_free(plugin->info->description);
-		g_free(plugin->info->author);
-		g_free(plugin->info->homepage);
+	if (plugin->info != NULL)
+	{
+		GaimPerlScript *gps;
+
+		if (plugin->info->name != NULL)
+			g_free(plugin->info->name);
+
+		if (plugin->info->version != NULL)
+			g_free(plugin->info->version);
+
+		if (plugin->info->summary != NULL)
+			g_free(plugin->info->summary);
+
+		if (plugin->info->description != NULL)
+			g_free(plugin->info->description);
+
+		if (plugin->info->author != NULL)
+			g_free(plugin->info->author);
+
+		if (plugin->info->homepage != NULL)
+			g_free(plugin->info->homepage);
+
+		gps = (GaimPerlScript *)plugin->info->extra_info;
+
+		if (gps != NULL)
+		{
+			if (gps->load_sub != NULL)
+				g_free(gps->load_sub);
+
+			if (gps->unload_sub != NULL)
+				g_free(gps->unload_sub);
+
+			g_free(gps);
+			plugin->info->extra_info = NULL;
+		}
 	}
 }

@@ -1483,8 +561,6 @@
 static void
 init_plugin(GaimPlugin *plugin)
 {
-	my_plugin = plugin;
-
 	loader_info.exts = g_list_append(loader_info.exts, "pl");
 }