Mercurial > pidgin
view libpurple/plugins/perl/scripts/buddy_list.pl @ 32035:bbe75a67c755
sametime: fix build (add_buddies added param)
author | Paul Aurich <paul@darkrain42.org> |
---|---|
date | Sun, 04 Sep 2011 18:42:42 +0000 |
parents | 0646207f360f |
children |
line wrap: on
line source
$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-aim"; 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"; }