view libpurple/plugins/perl/scripts/buddy_list.pl @ 18243:a8b19e002cb4

propagate from branch 'im.pidgin.pidgin' (head e9da27c3123d1223162bf9fb76f58822873e18f8) to branch 'im.pidgin.soc.2007.remotelogging' (head da5442aedd302aafb260948b66ce0549a3e0a0e4)

$MODULE_NAME = "Buddy List Test";

use Purple;

# All the information Purple 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_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;

	# This is how we get an account to use in the following tests.  You should replace the username
	#  with an existing user
	$account = Purple::Accounts::find($USERNAME, $PROTOCOL_ID);

	# Testing a find function: Note Purple::Find not Purple::Buddy:find!
	#  Furthermore, this should work the same for chats and groups
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::Find::buddy()...");
	$buddy = Purple::Find::buddy($account, $TEST_NAME);
	Purple::Debug::info("", ($buddy ? "ok." : "fail.") . "\n");

	# If you should need the handle for some reason, here is how you do it
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::BuddyList::get_handle()...");
	$handle = Purple::BuddyList::get_handle();
	Purple::Debug::info("", ($handle ? "ok." : "fail.") . "\n");

	# This gets the Purple::BuddyList and references it by $blist
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::get_blist()...");
	$blist = Purple::get_blist();
	Purple::Debug::info("", ($blist ? "ok." : "fail.") . "\n");

	# This is how you would add a buddy named $TEST_NAME" with the alias $TEST_ALIAS
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::BuddyList::Buddy::new...");
	$buddy = Purple::BuddyList::Buddy::new($account, $TEST_NAME, $TEST_ALIAS);
	Purple::Debug::info("", ($buddy ? "ok." : "fail.") . "\n");

	# Here we add the new buddy '$buddy' to the group $TEST_GROUP
	#  so first we must find the group
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::Find::group...");
	$group = Purple::Find::group($TEST_GROUP);
	Purple::Debug::info("", ($group ? "ok." : "fail.") . "\n");

	# To add the buddy we need to have the buddy, contact, group and node for insertion.
	#  For this example we can let contact be undef and set the insertion node as the group
	Purple::Debug::info($MODULE_NAME, "Testing: Purple::BuddyList::add_buddy...\n");
	Purple::BuddyList::add_buddy($buddy, undef, $group, $group);

	# The example that follows gives an indication of how an API call that returns a list is handled.
	#  In this case the buddies of the account found earlier are retrieved and put in an array '@buddy_array'
	#  Further down an accessor method is used, 'get_name()' -- see source for details on the full set of methods
	Purple::Debug::info($MODULE_NAME,  "Testing: Purple::Find::buddies...\n");
	@buddy_array = Purple::Find::buddies($account, undef);
	if (@buddy_array) {
		Purple::Debug::info($MODULE_NAME, "Buddies in list (" . @buddy_array . "): \n");
		foreach $bud (@buddy_array) {
			Purple::Debug::info($MODULE_NAME, Purple::BuddyList::Buddy::get_name($bud) . "\n");
		}
	}
}

sub plugin_unload {
	my $plugin = shift;

	print "#" x 80 . "\n\n";
	#########  TEST CODE HERE  ##########

	print "Testing: Purple::Find::buddy()...";
	$buddy = Purple::Find::buddy($account, $TEST_NAME . TEST);
	if ($buddy) {
		print "ok.\n";
		print "Testing: Purple::BuddyList::remove_buddy()...";
		Purple::BuddyList::remove_buddy($buddy);
		if (Purple::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; }
	} else { print "fail.\n"; }


	print "\n\n" . "#" x 80 . "\n\n";
}