diff libpurple/plugins/perl/scripts/account.pl @ 15373:5fe8042783c1

Rename gtk/ and libgaim/ to pidgin/ and libpurple/
author Sean Egan <seanegan@gmail.com>
date Sat, 20 Jan 2007 02:32:10 +0000
parents
children 2f8274ce570a
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libpurple/plugins/perl/scripts/account.pl	Sat Jan 20 02:32:10 2007 +0000
@@ -0,0 +1,122 @@
+$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 $USERNAME 		= "johnhkelm2";
+
+	# We will create these on load then destroy them on unload
+	my $TEST_NAME	 	= "perlTestName";
+	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($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Started.");
+	print "\n\n";
+
+
+	#################################
+	#				#
+	#	Gaim::Account::Option	#
+	#				#
+	#################################
+
+	print "Testing: Gaim::Account::Option::new()...\n";
+	$acc_opt  = Gaim::Account::Option->new(1, "TEXT", "pref_name");
+	$acc_opt2 = 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::Accounts::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 = $account->get_username();
+	if ($user_name) {
+		print "Success: $user_name.\n";
+	} else {
+		print "Failed!\n";
+	}
+
+	print "Testing: Gaim::Account::is_connected()... ";
+	if ($account->is_connected()) {
+		print " Connected.\n";
+	} else {
+		print " Disconnected.\n";
+	}
+
+	print "Testing: Gaim::Accounts::get_active_status()... ";
+	if ($account->get_active_status()) {
+		print "Okay.\n";
+	} else {
+		print "Failed!\n";
+	}
+
+	$account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID);
+	print "Testing: Gaim::Accounts::connect()...pending...\n";
+
+	$account->set_status("available", TRUE);
+	$account->connect();
+
+	print "\n\n";
+	Gaim::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Completed.\n");
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+
+sub plugin_unload {
+	my $plugin = shift;
+
+	print "#" x 80 . "\n\n";
+	Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Started.\n");
+	print "\n\n";
+
+	#########  TEST CODE HERE  ##########
+
+	print "\n\n";
+	Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Completed.\n");
+	print "\n\n" . "#" x 80 . "\n\n";
+}
+