Mercurial > pidgin

changeset 11170:0e9e2b923d09

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[gaim-migrate @ 13271] Fixed some bugs and made some additions to the XSUBS. Added some of my test scripts which are incomplete, but mostly functional. GaimPluginPrefs and GaimGtkPluginPrefs--using evals to do the Gtk widgets with gtk2-perl--work. Plugin actions can now be added, but only one for now. committer: Tailor Script <tailor@pidgin.im>
author John H. Kelm <johnkelm@gmail.com>
date Fri, 29 Jul 2005 13:38:00 +0000
parents 778d5464a9b8
children ebb02ea3c789
files plugins/perl/common/Conversation.xs plugins/perl/common/Plugin.xs plugins/perl/common/PluginPref.xs plugins/perl/common/Request.xs plugins/perl/common/Status.xs plugins/perl/common/module.h plugins/perl/common/typemap plugins/perl/perl-common.c plugins/perl/perl-common.h plugins/perl/perl-handlers.c plugins/perl/perl-handlers.h plugins/perl/perl.c plugins/perl/scripts/account.pl plugins/perl/scripts/buddy_list.pl plugins/perl/scripts/conversation.pl plugins/perl/scripts/count_down.pl plugins/perl/scripts/gtk_frame_test.pl plugins/perl/scripts/plugin_pref.pl plugins/perl/scripts/request.pl
diffstat 19 files changed, 959 insertions(+), 38 deletions(-) [+]
line wrap: on
line diff
--- a/plugins/perl/common/Conversation.xs	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/Conversation.xs	Fri Jul 29 13:38:00 2005 +0000
@@ -68,7 +68,10 @@
 OUTPUT:
 	RETVAL
 
-
+int
+gaim_conv_window_add_conversation(win, conv)
+	Gaim::ConvWindow win
+	Gaim::Conversation conv
 
 
 MODULE = Gaim::Conv  PACKAGE = Gaim::Conv  PREFIX = gaim_conversation_
@@ -225,9 +228,18 @@
 gaim_conversation_update(conv, type)
 	Gaim::Conversation conv
 	Gaim::ConvUpdateType type
-
+	
+Gaim::Conversation 
+gaim_conversation_new(type, account, name)
+	Gaim::ConversationType type		  
+	Gaim::Account account
+	const char *name
 
-
+void 
+gaim_conversation_set_account(conv, account);
+	Gaim::Conversation conv
+	Gaim::Account account
+	
 
 
 MODULE = Gaim::Conv  PACKAGE = Gaim::Conv::IM  PREFIX = gaim_conv_im_
@@ -300,9 +312,13 @@
 	Gaim::Conversation::IM im
 	const char *message
 
-
-
-
+void 
+gaim_conv_im_write(im, who, message, flags, mtime)
+	Gaim::Conversation::IM im
+	const char *who
+	const char *message
+	Gaim::MessageFlags flags
+	time_t mtime
 
 
 MODULE = Gaim::Conv  PACKAGE = Gaim::Conv  PREFIX = gaim_conv_
--- a/plugins/perl/common/Plugin.xs	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/Plugin.xs	Fri Jul 29 13:38:00 2005 +0000
@@ -4,6 +4,7 @@
 PROTOTYPES: ENABLE
 
 
+
 void 
 gaim_plugin_destroy(plugin)
 	Gaim::Plugin plugin
--- a/plugins/perl/common/PluginPref.xs	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/PluginPref.xs	Fri Jul 29 13:38:00 2005 +0000
@@ -127,5 +127,12 @@
 	Gaim::PluginPref pref
 	Gaim::PluginPrefType type
 CODE:
-	gaim_plugin_pref_set_type(pref, type);
+	GaimPluginPrefType gpp_type = GAIM_PLUGIN_PREF_NONE;
 
+	if (type == 1) {
+		gpp_type = GAIM_PLUGIN_PREF_CHOICE;
+	} else if (type == 2) {
+		gpp_type = GAIM_PLUGIN_PREF_INFO;
+	}
+	gaim_plugin_pref_set_type(pref, gpp_type);
+
--- a/plugins/perl/common/Request.xs	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/Request.xs	Fri Jul 29 13:38:00 2005 +0000
@@ -1,9 +1,60 @@
 #include "module.h"
 
+typedef struct {
+	char *cancel_cb;
+	char *ok_cb;
+} GaimPerlRequestData;
+
+/********************************************************/
+/*							*/
+/* Callback function that calls a perl subroutine 	*/
+/*							*/
+/* The void * field data is being used as a way to hide	*/
+/* the perl sub's name in a GaimPerlRequestData		*/
+/*							*/
+/********************************************************/
+void gaim_perl_request_ok_cb(void * data, GaimRequestFields *fields) {
+
+	GaimPerlRequestData *gpr = (GaimPerlRequestData *)data;
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(sp);
+	
+	XPUSHs(gaim_perl_bless_object(fields, "Gaim::Request::Fields"));
+	PUTBACK;
+	
+	call_pv(gpr->ok_cb, G_EVAL | G_SCALAR);
+	SPAGAIN;
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+}
+
+void gaim_perl_request_cancel_cb(void * data, GaimRequestFields *fields) {
+
+	GaimPerlRequestData *gpr = (GaimPerlRequestData *)data;
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(sp);
+	
+	XPUSHs(gaim_perl_bless_object(fields, "Gaim::Request::Fields"));
+	PUTBACK;
+	call_pv(gpr->cancel_cb, G_EVAL | G_SCALAR);
+	SPAGAIN;
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+}
+
+
 /* TODO
 
-void *
-gaim_request_fields(handle, title, primary, secondary, fields, ok_text, ok_cb, cancel_text, cancel_cb, user_data)
 
 void *
 gaim_request_input(handle, title, primary, secondary, default_value, multiline, masked, hint, ok_text, ok_cb, cancel_text, cancel_cb, user_data)
@@ -34,6 +85,42 @@
 MODULE = Gaim::Request  PACKAGE = Gaim::Request  PREFIX = gaim_request_
 PROTOTYPES: ENABLE
 
+void *
+gaim_request_fields(handle, title, primary, secondary, fields, ok_text, ok_cb, cancel_text, cancel_cb)
+	Gaim::Plugin handle
+	const char * title
+	const char * primary
+	const char * secondary
+	Gaim::Request::Fields fields
+	const char * ok_text
+	SV * ok_cb
+	const char * cancel_text
+	SV * cancel_cb
+CODE:
+	GaimPerlRequestData *gpr;
+	STRLEN len;
+	char *basename, *package;
+	
+	basename = g_path_get_basename(handle->path);
+	gaim_perl_normalize_script_name(basename);
+	package = g_strdup_printf("Gaim::Script::%s", basename);
+	gpr = g_new(GaimPerlRequestData, 1);
+	gpr->ok_cb = g_strdup_printf("%s::%s", package, SvPV(ok_cb, len));
+	gpr->cancel_cb = g_strdup_printf("%s::%s", package, SvPV(cancel_cb, len));
+	
+	RETVAL = gaim_request_fields(handle, title, primary, secondary, fields, ok_text, G_CALLBACK(gaim_perl_request_ok_cb), cancel_text, G_CALLBACK(gaim_perl_request_cancel_cb), gpr);
+OUTPUT:
+	RETVAL
+
+
+
+
+
+
+
+
+
+
 
 void *
 gaim_request_action_varg(handle, title, primary, secondary, default_action, user_data, action_count, actions)
--- a/plugins/perl/common/Status.xs	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/Status.xs	Fri Jul 29 13:38:00 2005 +0000
@@ -45,6 +45,7 @@
 	
 */
 
+/***************************XS Code Status.xs**************************/
 MODULE = Gaim::Status  PACKAGE = Gaim::Presence  PREFIX = gaim_presence_
 PROTOTYPES: ENABLE
 
@@ -359,7 +360,9 @@
 		STRLEN t_sl;
 		t_GL = g_list_append(t_GL, SvPV(*av_fetch((AV *)SvRV(status_types), i, 0), t_sl));
 	}
-	gaim_status_type_find_with_id(t_GL, id);
+	RETVAL = (GaimStatusType *)gaim_status_type_find_with_id(t_GL, id);
+OUTPUT:
+	RETVAL
 	
 Gaim::StatusAttr
 gaim_status_type_get_attr(status_type, id)
--- a/plugins/perl/common/module.h	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/module.h	Fri Jul 29 13:38:00 2005 +0000
@@ -169,7 +169,7 @@
 typedef GaimPluginInfo *                Gaim__PluginInfo;
 typedef GaimPluginUiInfo *              Gaim__PluginUiInfo;
 typedef GaimPluginLoaderInfo *          Gaim__PluginLoaderInfo;
-typedef GaimPluginAction *              Gaim__PluginAction;
+typedef GaimPluginAction *              Gaim__Plugin__Action;
 
 	/* pluginpref.h */
 typedef GaimPluginPrefFrame *           Gaim__PluginPrefFrame;
--- a/plugins/perl/common/typemap	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/common/typemap	Fri Jul 29 13:38:00 2005 +0000
@@ -144,6 +144,7 @@
 
 Gaim::Status				T_GaimObj
 Gaim::StatusType			T_GaimObj
+const Gaim::StatusType			T_GaimObj
 Gaim::StatusAttr  		         T_GaimObj
 Gaim::Presence 			         T_GaimObj
 Gaim::PresenceContext           	T_IV
--- a/plugins/perl/perl-common.c	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/perl-common.c	Fri Jul 29 13:38:00 2005 +0000
@@ -7,6 +7,23 @@
 
 static GHashTable *object_stashes = NULL;
 
+void gaim_perl_normalize_script_name(char *name)
+{
+        char *c;
+
+        c = strrchr(name, '.');
+
+        if (c != NULL)
+                *c = '\0';
+
+        for (c = name; *c != '\0'; c++)
+        {
+                if (*c != '_' && !g_ascii_isalnum(*c))
+                        *c = '_';
+        }
+}
+
+
 static int
 magic_free_object(pTHX_ SV *sv, MAGIC *mg)
 {
--- a/plugins/perl/perl-common.h	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/perl-common.h	Fri Jul 29 13:38:00 2005 +0000
@@ -23,6 +23,9 @@
 		gaim_perl_callXS(boot_Gaim__##x, cv, mark); \
 	}
 
+void gaim_perl_normalize_script_name(char *name);
+
+
 SV *newSVGChar(const char *str);
 
 void gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark);
--- a/plugins/perl/perl-handlers.c	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/perl-handlers.c	Fri Jul 29 13:38:00 2005 +0000
@@ -4,23 +4,113 @@
 #include "debug.h"
 #include "signals.h"
 
+
 static GList *timeout_handlers = NULL;
 static GList *signal_handlers = NULL;
 static char *perl_plugin_pref_cb;
+static char *perl_gtk_plugin_pref_cb;
 extern PerlInterpreter *my_perl;
 
+/* For now a plugin can only have one action */
+void gaim_perl_plugin_action_cb(GaimPluginAction * gpa) {
+
+        dSP;
+        ENTER;
+        SAVETMPS;
+        PUSHMARK(sp);
+
+	/* We put the plugin handle on the stack so it can pass it along 	*/
+	/* to anythng called from the callback.  It is supposed to pass		*/
+	/* the Action, but there is no way to access the plugin handle from	*/
+	/* the GaimPluginAction in perl...yet.					*/
+
+	XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin"));
+        PUTBACK;
+
+	/* gaim_perl_plugin_action_callback_sub defined in the header is set	*/
+	/* in perl.c during plugin probe by a PLUGIN_INFO hash value limiting	*/
+	/* us to only one action for right now even though the action member of	*/
+	/* GaimPluginInfo can take (does take) a GList.				*/
+        call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR);
+        SPAGAIN;
+
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+}
+
+GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) {
+        GaimPluginAction *act = NULL;
+        GList *gl = NULL;
+
+	/* TODO: Fix the way we create action handlers so we can have mroe than	*/
+	/* one action in perl.  Maybe there is a clever work around, but so far	*/
+	/* I have not figured it out.  There is no way to tie the perl sub's	*/
+	/* name to the callback function without these global variables and 	*/
+	/* there is no way to create a callback on the fly so each would have	*/
+	/* to be hardcoded--more than one would just be arbitrary.		*/
+        act = gaim_plugin_action_new(gaim_perl_plugin_action_label, gaim_perl_plugin_action_cb);
+        gl = g_list_append(gl, act);
+
+        return gl;
+}
+
+
+GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb) {
+
+	GaimGtkPluginUiInfo *ui_info;
+	
+	ui_info = g_new0(GaimGtkPluginUiInfo, 1);
+	perl_gtk_plugin_pref_cb = g_strdup(frame_cb);
+	ui_info->get_config_frame = gaim_perl_gtk_get_plugin_frame;
+	
+	return ui_info;
+}
+
+GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) {
+	
+	SV * sv;
+	GtkWidget *ret;
+	MAGIC *mg;
+	dSP;
+	int count;
+
+	ENTER;
+	SAVETMPS;
+
+	count = call_pv(perl_gtk_plugin_pref_cb, G_SCALAR | G_NOARGS);
+	if (count != 1)
+		croak("call_pv: Did not return the correct number of values.\n");
+	
+	/* the frame was created in a perl sub and is returned */
+	SPAGAIN;
+
+	/* We have a Gtk2::Frame on top of the stack */
+	sv = POPs;	
+
+	/* The magic field hides the pointer to the actuale GtkWidget */
+	mg = mg_find(SvRV(sv), PERL_MAGIC_ext);
+	ret = (GtkWidget *)mg->mg_ptr;
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;		
+	
+	return ret;
+}
+
+
+
 
 /* Called to create a pointer to GaimPluginUiInfo for the GaimPluginInfo 	*/
 /*	It will then inturn create ui_info with the C function pointer 		*/
 /*	that will eventually do a call_pv to call a perl functions so users	*/
 /*	can create their own frames in the prefs				*/
-GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb) {
+GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb) {
 	GaimPluginUiInfo *ui_info;
 	
 	ui_info = g_new0(GaimPluginUiInfo, 1);
-	
-	perl_plugin_pref_cb = frame_cb;
-	
+	perl_plugin_pref_cb = g_strdup(frame_cb);
 	ui_info->get_plugin_pref_frame = gaim_perl_get_plugin_frame;
 
 	return ui_info;
@@ -53,7 +143,7 @@
 	PUTBACK;
 	FREETMPS;
 	LEAVE;
-		
+	
 	return ret_frame;
 }
 
--- a/plugins/perl/perl-handlers.h	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/perl-handlers.h	Fri Jul 29 13:38:00 2005 +0000
@@ -4,6 +4,13 @@
 #include "plugin.h"
 #include "prefs.h"
 #include "pluginpref.h"
+#include "gtkplugin.h"
+#include "gtkutils.h"
+
+/* TODO: Find a better way to access the perl names from the plugin prober	*/
+/* and store them for gaim_perl_plugin_action_* functions.			*/
+char * gaim_perl_plugin_action_callback_sub;
+char * gaim_perl_plugin_action_label;
 
 typedef struct
 {
@@ -24,9 +31,15 @@
 
 } GaimPerlSignalHandler;
 
-GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb);
+void gaim_perl_plugin_action_cb(GaimPluginAction * gpa);
+GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context); 
+
+GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb);
 GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin);
 
+GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb);
+GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin);
+
 void gaim_perl_timeout_add(GaimPlugin *plugin, int seconds, SV *callback,
 						   SV *data);
 void gaim_perl_timeout_clear_for_plugin(GaimPlugin *plugin);
--- a/plugins/perl/perl.c	Fri Jul 29 05:05:52 2005 +0000
+++ b/plugins/perl/perl.c	Fri Jul 29 13:38:00 2005 +0000
@@ -102,7 +102,6 @@
 	char *package;
 	char *load_sub;
 	char *unload_sub;
-
 } GaimPerlScript;
 
 
@@ -222,23 +221,6 @@
 	PUTBACK;
 }
 
-static void
-normalize_script_name(char *name)
-{
-	char *c;
-
-	c = strrchr(name, '.');
-
-	if (c != NULL)
-		*c = '\0';
-
-	for (c = name; *c != '\0'; c++)
-	{
-		if (*c != '_' && !g_ascii_isalnum(*c))
-			*c = '_';
-	}
-}
-
 static gboolean
 probe_perl_plugin(GaimPlugin *plugin)
 {
@@ -301,7 +283,7 @@
 			gps->plugin = plugin;
 
 			basename = g_path_get_basename(plugin->path);
-			normalize_script_name(basename);
+			gaim_perl_normalize_script_name(basename);
 			gps->package = g_strdup_printf("Gaim::Script::%s", basename);
 			g_free(basename);
 
@@ -309,9 +291,12 @@
 			key = hv_fetch(plugin_info, "name", strlen("name"), 0);
 			info->name = g_strdup(SvPV(*key, len));
 
+			if ((key = hv_fetch(plugin_info, "GTK_UI", strlen("GTK_UI"), 0)))
+				info->ui_requirement = GAIM_GTK_PLUGIN_TYPE;
+
 			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));
 
@@ -334,10 +319,46 @@
 				gps->unload_sub = g_strdup_printf("%s::%s", gps->package,
 												  SvPV(*key, len));
 
+			/********************************************************/
+			/* Only one of the next two options should be present 	*/
+			/*							*/
+			/* prefs_info - Uses non-GUI (read GTK) gaim API calls	*/
+			/*		and creates a GaimPluginPrefInfo type.	*/
+			/*							*/
+			/* gtk_prefs_info - Requires gtk2-perl be installed by	*/
+			/*		the user and he must create a GtkWidget */
+			/* 		representing the plugin preferences	*/
+			/*		page.					*/
+			/********************************************************/
 			if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) {
 				/* key now is the name of the Perl sub that will create a frame for us */
 				info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)));
 			}
+			
+			if ((key = hv_fetch(plugin_info, "gtk_prefs_info", strlen("gtk_prefs_info"), 0))) {
+				/* key now is the name of the Perl sub that will create a frame for us */
+				info->ui_info = gaim_perl_gtk_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)));
+			}
+
+			/********************************************************/
+			/* 							*/
+			/* plugin_action - This is given to the plugin info	*/		
+			/*	as the action GList.  There are two parts 	*/
+			/*	so the user can set the title as it will appear	*/
+			/*	in the plugin action menu.  The name is 	*/
+			/*	extracted and then the callback perl sub's name	*/
+			/* 	both of which then are handled by an internal	*/
+			/*	gaim_perl function that sets up the single cb	*/
+			/*	function which is then inserted into 'info'.	*/
+			/********************************************************/
+			if ((key = hv_fetch(plugin_info, "plugin_action_label", strlen("plugin_action_label"), 0))) {
+				gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len));
+			}
+
+			if ((key = hv_fetch(plugin_info, "plugin_action", strlen("plugin_action"), 0))) {
+				gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len));
+				info->actions = gaim_perl_plugin_action;
+			}
 
 			plugin->info = info;
 			info->extra_info = gps;
@@ -345,7 +366,7 @@
 			status = gaim_plugin_register(plugin);
 		}
 	}
-
+	
 	perl_destruct(prober);
 	perl_free(prober);
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/account.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,112 @@
+$MODULE_NAME = "Account Functions Test";
+
+use Gaim;
+
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com", 
+	url => "http://sourceforge.net/users/johnhkelm/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload" 
+); 
+
+
+	# These names must already exist
+	my $GROUP		= "UIUC Buddies";
+	my $USERNAME 		= "johnhkelm2";
+	
+	# We will create these on load then destroy them on unload
+	my $TEST_GROUP		= "perlTestGroup";
+	my $TEST_NAME	 	= "perlTestName";
+	my $TEST_ALIAS	 	= "perlTestAlias";
+	my $PROTOCOL_ID 	= "prpl-oscar";
+
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+
+# This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
+#	Note: The plugin has a reference to itself on top of the argument stack.
+sub plugin_load { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n\n";
+	Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Started.");
+	print "\n\n";
+	
+
+	#################################
+	#				#
+	#	Gaim::Account::Option	#
+	#				#
+	#################################
+
+	print "Testing: Gaim::Account::Option::new...\n";
+	$account_opt = Gaim::Account::Option::new(1, "TEXT", "pref_name"); 
+	Gaim::Account::Option::bool_new("TeXt", "MYprefName", 1);
+	
+	#################################
+	#				#
+	#	Gaim::Account		#
+	#				#
+	#################################
+
+
+	print "Testing: Gaim::Account::new()...";
+	$account = Gaim::Account::new($TEST_NAME, $PROTOCOL_ID);
+	if ($account) { print "ok.\n"; } else { print "fail.\n"; }
+
+	print "Testing: Gaim::Account::add()...";
+	Gaim::Accounts::add($account);
+		print "pending find...\n"; 
+
+	print "Testing: Gaim::Accounts::find()...";
+	$account = Gaim::Accounts::find($TEST_NAME, $PROTOCOL_ID);
+	if ($account) { print "ok.\n"; } else { print "fail.\n"; }
+	
+	print "Testing: Gaim::Account::get_username()...";
+	$user_name = Gaim::Account::get_username($account);
+	if ($user_name) { print $user_name . "...ok.\n"; } else { print "fail.\n"; }
+
+
+	print "Testing: Gaim::Account::is_connected()";
+	$user_connected = Gaim::Account::is_connected($account);
+	if (!($user_connected)) { print "...not connected...ok..\n"; } else { print "...connected...ok.\n"; }
+
+
+	print "Testing: Gaim::Accounts::get_active_status()...";
+	$status = Gaim::Account::get_active_status($account);
+	if ($status) { print "ok.\n"; } else { print "fail.\n"; }
+
+	$account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID);
+	print "Testing: Gaim::Accounts::connect()...pending...\n";
+	
+	Gaim::Account::set_status($account, "available", TRUE);
+	Gaim::Account::connect($account);
+
+	print "\n\n";
+	Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed.");
+	print "\n\n" . "#" x 80 . "\n\n";
+} 
+
+sub plugin_unload { 
+	my $plugin = shift; 
+
+	print "#" x 80 . "\n\n";
+	Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Started.");
+	print "\n\n";
+
+	#########  TEST CODE HERE  ##########
+
+	print "\n\n";
+	Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Completed.");
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/buddy_list.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,101 @@
+$MODULE_NAME = "Buddy List Test";
+
+use Gaim;
+
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com", 
+	url => "http://sourceforge.net/users/johnhkelm/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload" 
+); 
+
+
+	# These names must already exist
+	my $GROUP		= "UIUC Buddies";
+	my $USERNAME 		= "johnhkelm2";
+	
+	# We will create these on load then destroy them on unload
+	my $TEST_GROUP		= "UConn Buddies";
+	my $TEST_NAME	 	= "johnhkelm";
+	my $TEST_ALIAS	 	= "John Kelm";
+	my $PROTOCOL_ID 	= "prpl-oscar";
+
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+
+# This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
+#	Note: The plugin has a reference to itself on top of the argument stack.
+sub plugin_load { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n\n";
+
+	print "PERL: Finding account.\n";
+	$account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID);
+	
+	#########  TEST CODE HERE  ##########
+	
+	print "Testing: Gaim::Find::buddy()...";
+	$buddy = Gaim::Find::buddy($account, $TEST_NAME);
+	if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }	
+	
+	print "Testing: Gaim::BuddyList::get_handle()...";
+	$handle = Gaim::BuddyList::get_handle();
+	if ($handle) { print "ok.\n"; } else { print "fail.\n"; }	
+	
+	print "Testing: Gaim::BuddyList::get_blist()...";	
+	$blist = Gaim::BuddyList::get_blist();
+	if ($blist) { print "ok.\n"; } else { print "fail.\n"; }	
+	
+	print "Testing: Gaim::Buddy::new...";
+	$buddy = Gaim::Buddy::new($account, $TEST_NAME . "TEST", $TEST_ALIAS);
+	if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }
+
+	print "Testing: Gaim::Find::group...";
+	$group = Gaim::Find::group($TEST_GROUP);
+	if ($group) { print "ok.\n"; } else { print "fail.\n"; }
+	
+	print "Testing: Gaim::BuddyList::add_buddy...";
+	Gaim::BuddyList::add_buddy($buddy, undef, $group, $group);
+	if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }
+	
+	print "Testing: Gaim::Find::buddies...\n";	
+	@buddy_array = Gaim::Find::buddies($account, $USERNAME);
+	if (@buddy_array) { 
+		print "Buddies in list (" . @buddy_array . "): \n";
+		foreach $bud (@buddy_array) {	
+			print Gaim::Buddy::get_name($bud) . "\n";
+		}
+	}
+
+	print "#" x 80 . "\n\n";
+} 
+
+sub plugin_unload { 
+	my $plugin = shift; 
+
+	print "#" x 80 . "\n\n";
+	#########  TEST CODE HERE  ##########
+
+	print "Testing: Gaim::Find::buddy()...";
+	$buddy = Gaim::Find::buddy($account, $TEST_NAME . TEST);
+	if ($buddy) { 
+		print "ok.\n";
+		print "Testing: Gaim::BuddyList::remove_buddy()...";
+		Gaim::BuddyList::remove_buddy($buddy);
+		if (Gaim::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; }
+	} else { print "fail.\n"; }
+
+
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/conversation.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,99 @@
+$MODULE_NAME = "Conversation Test";
+
+use Gaim;
+
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com", 
+	url => "http://sourceforge.net/users/johnhkelm/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload" 
+); 
+
+
+	# These names must already exist
+	my $GROUP		= "UIUC Buddies";
+	my $USERNAME 		= "johnhkelm2";
+	
+	# We will create these on load then destroy them on unload
+	my $TEST_GROUP		= "UConn Buddies";
+	my $TEST_NAME	 	= "johnhkelm";
+	my $TEST_ALIAS	 	= "John Kelm";
+	my $PROTOCOL_ID 	= "prpl-oscar";
+
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+
+# This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
+#	Note: The plugin has a reference to itself on top of the argument stack.
+sub plugin_load { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n\n";
+
+	print "PERL: Finding account.\n";
+	$account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID);
+	
+	#########  TEST CODE HERE  ##########
+	print "Testing Gaim::Conv::new()...";
+	$conv1 = Gaim::Conv::new(1, $account, "Test Conv. 1");
+	if ($conv) { print "ok.\n"; } else { print "fail.\n"; }
+
+	print "Testing Gaim::Conv::new()...";
+	$conv2 = Gaim::Conv::new(1, $account, "Test Conv. 2");
+	if ($conv) { print "ok.\n"; } else { print "fail.\n"; }
+	
+	print "Testing Gaim::Conv::Window::new()...\n";
+	$win = Gaim::Conv::Window::new();	
+	
+	print "Testing Gaim::Conv::Window::add_conversation()...";
+	$conv_count = Gaim::Conv::Window::add_conversation($win, $conv1);
+	if ($conv_count) { print "ok..." . $conv_count . " conversations...\n"; } else { print "fail.\n"; }
+
+	print "Testing Gaim::Conv::Window::add_conversation()...";
+	$conv_count = Gaim::Conv::Window::add_conversation($win, $conv2);
+	if ($conv_count) { print "ok..." . $conv_count . " conversations...\n"; } else { print "fail.\n"; }
+	
+	print "Testing Gaim::Conv::Window::show()...\n";
+	Gaim::Conv::Window::show($win);
+	
+	print "Testing Gaim::Conv::get_im_data()...\n";
+	$im = Gaim::Conv::get_im_data($conv1);	
+	if ($im) { print "ok.\n"; } else { print "fail.\n"; }
+	
+	print "Testing Gaim::Conv::IM::send()...\n";
+	Gaim::Conv::IM::send($im, "Message Test.");
+	
+	print "Testing Gaim::Conv::IM::write()...\n";
+	Gaim::Conv::IM::write($im, "sendingUser", "<b>Message</b> Test.", 0, 0);
+	
+	print "#" x 80 . "\n\n";
+} 
+
+sub plugin_unload { 
+	my $plugin = shift; 
+
+	print "#" x 80 . "\n\n";
+	#########  TEST CODE HERE  ##########
+
+
+	
+	print "Testing Gaim::Conv::Window::get_conversation_count()...\n";
+	$conv_count = Gaim::Conv::Window::get_conversation_count($win);
+	print $conv_count;
+	if ($conv_count > 0) {
+		print "Testing Gaim::Conv::Window::destroy()...\n";
+		Gaim::Conv::Window::destroy($win);
+	}
+	
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/count_down.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,89 @@
+use Gaim;
+
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => "Countdown Info Timer", 
+	version => "0.1", 
+	summary => "Makes a countdown in days from today.", 
+	description => "Long description coming....", 
+	author => "John H. Kelm <johnhkelm\@gmail.com>", 
+	url => "http://gaim.sourceforge.net/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload" 
+); 
+
+	$GLOBAL_TEST_VAR = "STUFF!";
+
+sub plugin_unload { 
+	my $plugin = shift; 
+}
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+
+sub plugin_load { 
+	my $plugin = shift; 
+	
+	# Retrieve all the accounts
+	@accounts = Gaim::Accounts::get_all();
+	
+	print "NUM OF ACCS: " . $accounts . "\n";
+	# Search each account's user info for our tag
+	foreach $acc (@accounts) {
+		print "IN ACCOUNTS\n";
+		$user_info = Gaim::Account::get_user_info($acc);
+		print "USER INFO 1: " . $user_info . "\n";
+		# Find <countdown> and replace
+		$user_info =~ /countdown([0-9]+).([0-9]+).([0-9]+)/;
+		print "Found: " .$1 . " " . $2 . " " . $3 . "\n";
+		$days = count_days($1, $2, $3);
+		$user_info =~ s/countdown(\d\d\d\d).(\d\d).(\d\d)/$days/;
+		print "USER INFO 2: " . $user_info . "\n";
+	#	Gaim::Account::set_user_info($acc, $user_info);
+	
+	}
+	
+	eval '
+		use Gtk2 \'-init\';
+		use Glib;
+		$window = Gtk2::Window->new(\'toplevel\');
+		$window->set_border_width(10);
+		$button = Gtk2::Button->new("Hello World");
+		$button->signal_connect(clicked => \&hello, $window);
+		
+		$window->add($button);
+		$button->show;
+		$window->show;
+	#	Gtk2->main;
+		
+		0;
+		
+	'; warn $@ if $@;
+}
+
+sub hello {
+	my ($widget, $window) = @_;
+	print "Called from sub hello!\n ";
+	print "Test var: " . $GLOBAL_TEST_VAR . " \n";
+	@accounts = Gaim::Accounts::get_all();
+	$acc = $accounts[0];
+	$user_info = Gaim::Account::get_user_info($acc);
+	print "USER INFO from sub hello: " . $user_info . "\n";
+	$window->destroy;
+}
+
+sub count_days {
+	($year, $month, $day) = @_;
+	
+	
+	eval '
+		use Time::Local;
+		$future = timelocal(0,0,0,$day,$month-1,$year); 
+	'; warn $@ if $@;
+	$today = time();
+	$days = int(($future - $today)/(60*60*24));
+	return $days;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/gtk_frame_test.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,66 @@
+$MODULE_NAME = "GTK Frame Test";
+
+use Gaim;
+
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com", 
+	url => "http://gaim.sourceforge.net/", 
+	
+	GTK_UI => TRUE,
+	gtk_prefs_info => "foo",
+	load => "plugin_load",
+	unload => "plugin_unload",
+); 
+
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+sub button_cb {
+	my $widget = shift;
+	my $data = shift;
+	print "Clicked button with message: " . $data . "\n";
+}
+
+sub foo {
+	eval '
+		use Glib;
+		use Gtk2 \'-init\';
+				
+		$frame = Gtk2::Frame->new(\'Gtk Test Frame\');
+		$button = Gtk2::Button->new(\'Print Message\');
+		
+		$frame->set_border_width(10);
+		$button->set_border_width(150);
+		$button->signal_connect("clicked" => \&button_cb, "Message Text");
+		$frame->add($button);
+		
+		$button->show();
+		$frame->show();
+	';
+	return $frame;
+}
+
+sub plugin_load { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n";
+
+	
+	#########  TEST CODE HERE  ##########
+
+	print "$MODULE_NAME: Loading...\n";
+	
+	
+	Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed.");
+	print "#" x 80 . "\n\n";
+} 
+
+sub plugin_unload {
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/plugin_pref.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,86 @@
+$MODULE_NAME = "Prefs Functions Test";
+use Gaim;
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com>", 
+	url => "http://sourceforge.net/users/johnhkelm/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload", 
+	prefs_info => "foo"
+); 
+
+	# These names must already exist
+	my $GROUP		= "UIUC Buddies";
+	my $USERNAME 		= "johnhkelm2";
+	
+	# We will create these on load then destroy them on unload
+	my $TEST_GROUP		= "perlTestGroup";
+	my $TEST_NAME	 	= "perlTestName";
+	my $TEST_ALIAS	 	= "perlTestAlias";
+	my $PROTOCOL_ID 	= "prpl-oscar";
+
+sub foo {
+	$frame = Gaim::Pref::frame_new();
+
+	$ppref = Gaim::Pref::new_with_label("boolean");
+	Gaim::Pref::frame_add($frame, $ppref);
+	
+	$ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/bool", "Boolean Preference");
+	Gaim::Pref::frame_add($frame, $ppref);	
+
+		
+	$ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/choice", "Choice Preference");
+	Gaim::Pref::set_type($ppref, 1);
+	Gaim::Pref::add_choice($ppref, "foo", $frame);
+	Gaim::Pref::add_choice($ppref, "bar", $frame);
+	Gaim::Pref::frame_add($frame, $ppref);
+	
+	$ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/text", "Text Box Preference");
+	Gaim::Pref::set_max_length($ppref, 16);
+	Gaim::Pref::frame_add($frame, $ppref);
+	
+	return $frame;
+}
+
+sub plugin_init { 
+	
+	return %PLUGIN_INFO; 
+} 
+
+
+# This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
+#	Note: The plugin has a reference to itself on top of the argument stack.
+sub plugin_load { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n\n";
+
+
+	#########  TEST CODE HERE  ##########
+
+	Gaim::Prefs::add_none("/plugins/core/perl_test");
+	Gaim::Prefs::add_bool("/plugins/core/perl_test/bool", 1);	
+	Gaim::Prefs::add_string("/plugins/core/perl_test/choice", "bar");	
+	Gaim::Prefs::add_string("/plugins/core/perl_test/text", "Foo");	
+	
+
+	print "\n\n" . "#" x 80 . "\n\n";
+} 
+
+sub plugin_unload { 
+	my $plugin = shift; 
+
+	print "#" x 80 . "\n\n";
+
+
+	#########  TEST CODE HERE  ##########
+
+
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/request.pl	Fri Jul 29 13:38:00 2005 +0000
@@ -0,0 +1,109 @@
+$MODULE_NAME = "Request Functions Test";
+
+use Gaim;
+
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = ( 
+	perl_api_version => 2, 
+	name => " Perl: $MODULE_NAME", 
+	version => "0.1", 
+	summary => "Test plugin for the Perl interpreter.", 
+	description => "Implements a set of test proccedures to ensure all functions that work in the C API still work in the Perl plugin interface.  As XSUBs are added, this *should* be updated to test the changes.  Furthermore, this will function as the tutorial perl plugin.", 
+	author => "John H. Kelm <johnhkelm\@gmail.com", 
+	url => "http://sourceforge.net/users/johnhkelm/", 
+	
+	load => "plugin_load", 
+	unload => "plugin_unload", 
+	plugin_action => "plugin_action_test",
+	plugin_action_label => "Plugin Action Test Label"
+); 
+
+
+	# These names must already exist
+	my $GROUP		= "UIUC Buddies";
+	my $USERNAME 		= "johnhkelm2";
+	
+	# We will create these on load then destroy them on unload
+	my $TEST_GROUP		= "perlTestGroup";
+	my $TEST_NAME	 	= "perlTestName";
+	my $TEST_ALIAS	 	= "perlTestAlias";
+	my $PROTOCOL_ID 	= "prpl-oscar";
+
+
+sub plugin_init { 
+	return %PLUGIN_INFO; 
+} 
+
+sub ok_cb_test{
+	$fields = shift;
+	print "ok_cb_test: BEGIN\n";
+	print "ok_cb_test: Button Click\n";
+	print "ok_cb_test: Field Type: " . $fields . "\n";
+	$account = Gaim::Request::fields_get_account($fields, "acct_test");
+	print "ok_cb_test: Username of selected account: " . Gaim::Account::get_username($account) . "\n";
+	$int = Gaim::Request::fields_get_integer($fields, "int_test");
+	print "ok_cb_test: Integer Value:" . $int . "\n";
+	$choice = Gaim::Request::fields_get_choice($fields, "ch_test");
+	print "ok_cb_test: Choice Value:" . $choice . "\n";
+	print "ok_cb_test: END\n";
+}
+
+sub cancel_cb_test{
+	print "cancel_cb_test: Button Click\n";
+}
+
+sub plugin_action_test {
+	$plugin = shift;
+	print "plugin_action_cb_test: BEGIN\n";
+	plugin_request($plugin);
+	print "plugin_action_cb_test: END\n";
+}
+
+sub plugin_load { 
+	my $plugin = shift; 
+	#########  TEST CODE HERE  ##########
+	
+
+}
+
+sub plugin_request {	
+	$group = Gaim::Request::field_group_new("Group Name");
+	$field = Gaim::Request::field_account_new("acct_test", "Account Text", undef);
+	Gaim::Request::field_account_set_show_all($field, 0);
+	Gaim::Request::field_group_add_field($group, $field);
+	
+	$field = Gaim::Request::field_int_new("int_test", "Integer Text", 33);
+	Gaim::Request::field_group_add_field($group, $field);
+	
+	# Test field choice
+	$field = Gaim::Request::field_choice_new("ch_test", "Choice Text", 1);
+	Gaim::Request::field_choice_add($field, "Choice 0");
+	Gaim::Request::field_choice_add($field, "Choice 1");
+	Gaim::Request::field_choice_add($field, "Choice 2");
+	
+	Gaim::Request::field_group_add_field($group, $field);
+	
+	
+	$request = Gaim::Request::fields_new();
+	Gaim::Request::fields_add_group($request, $group);
+	
+	Gaim::Request::fields(
+		$plugin, 
+		"Request Title!", 
+		"Primary Title", 
+		"Secondary Title",
+		$request,
+		"Ok Text", "ok_cb_test",
+		"Cancel Text", "cancel_cb_test");
+} 
+
+sub plugin_unload { 
+	my $plugin = shift; 
+	print "#" x 80 . "\n";
+	#########  TEST CODE HERE  ##########
+	
+	
+
+	print "\n" . "#" x 80 . "\n";
+}
+