comparison: libgaim/plugins/perl/scripts/buddy_list.pl
libgaim/plugins/perl/scripts/buddy_list.pl
- branch
- gaim
- changeset 20470
- 77693555855f
- parent 11457
- e787f1445e64
- parent 15166
- 8febc283dead
- child 20471
- 1966704b3e42
equal
deleted
inserted
replaced
| 13071:b98e72d4089a | 20470:77693555855f |
|---|---|
| 1 $MODULE_NAME = "Buddy List Test"; | |
| 2 | |
| 3 use Gaim; | |
| 4 | |
| 5 # All the information Gaim gets about our nifty plugin | |
| 6 %PLUGIN_INFO = ( | |
| 7 perl_api_version => 2, | |
| 8 name => "Perl: $MODULE_NAME", | |
| 9 version => "0.1", | |
| 10 summary => "Test plugin for the Perl interpreter.", | |
| 11 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.", | |
| 12 author => "John H. Kelm <johnhkelm\@gmail.com>", | |
| 13 url => "http://sourceforge.net/users/johnhkelm/", | |
| 14 | |
| 15 load => "plugin_load", | |
| 16 unload => "plugin_unload" | |
| 17 ); | |
| 18 | |
| 19 | |
| 20 # These names must already exist | |
| 21 my $USERNAME = "johnhkelm2"; | |
| 22 | |
| 23 # We will create these on load then destroy them on unload | |
| 24 my $TEST_GROUP = "UConn Buddies"; | |
| 25 my $TEST_NAME = "johnhkelm"; | |
| 26 my $TEST_ALIAS = "John Kelm"; | |
| 27 my $PROTOCOL_ID = "prpl-oscar"; | |
| 28 | |
| 29 | |
| 30 sub plugin_init { | |
| 31 return %PLUGIN_INFO; | |
| 32 } | |
| 33 | |
| 34 | |
| 35 # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded | |
| 36 # Note: The plugin has a reference to itself on top of the argument stack. | |
| 37 sub plugin_load { | |
| 38 my $plugin = shift; | |
| 39 | |
| 40 # This is how we get an account to use in the following tests. You should replace the username | |
| 41 # with an existing user | |
| 42 $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); | |
| 43 | |
| 44 # Testing a find function: Note Gaim::Find not Gaim::Buddy:find! | |
| 45 # Furthermore, this should work the same for chats and groups | |
| 46 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddy()..."); | |
| 47 $buddy = Gaim::Find::buddy($account, $TEST_NAME); | |
| 48 Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); | |
| 49 | |
| 50 # If you should need the handle for some reason, here is how you do it | |
| 51 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::get_handle()..."); | |
| 52 $handle = Gaim::BuddyList::get_handle(); | |
| 53 Gaim::Debug::info("", ($handle ? "ok." : "fail.") . "\n"); | |
| 54 | |
| 55 # This gets the Gaim::BuddyList and references it by $blist | |
| 56 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::get_blist()..."); | |
| 57 $blist = Gaim::get_blist(); | |
| 58 Gaim::Debug::info("", ($blist ? "ok." : "fail.") . "\n"); | |
| 59 | |
| 60 # This is how you would add a buddy named $TEST_NAME" with the alias $TEST_ALIAS | |
| 61 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::Buddy::new..."); | |
| 62 $buddy = Gaim::BuddyList::Buddy::new($account, $TEST_NAME, $TEST_ALIAS); | |
| 63 Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); | |
| 64 | |
| 65 # Here we add the new buddy '$buddy' to the group $TEST_GROUP | |
| 66 # so first we must find the group | |
| 67 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::group..."); | |
| 68 $group = Gaim::Find::group($TEST_GROUP); | |
| 69 Gaim::Debug::info("", ($group ? "ok." : "fail.") . "\n"); | |
| 70 | |
| 71 # To add the buddy we need to have the buddy, contact, group and node for insertion. | |
| 72 # For this example we can let contact be undef and set the insertion node as the group | |
| 73 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::add_buddy...\n"); | |
| 74 Gaim::BuddyList::add_buddy($buddy, undef, $group, $group); | |
| 75 | |
| 76 # The example that follows gives an indication of how an API call that returns a list is handled. | |
| 77 # In this case the buddies of the account found earlier are retrieved and put in an array '@buddy_array' | |
| 78 # Further down an accessor method is used, 'get_name()' -- see source for details on the full set of methods | |
| 79 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddies...\n"); | |
| 80 @buddy_array = Gaim::Find::buddies($account, undef); | |
| 81 if (@buddy_array) { | |
| 82 Gaim::Debug::info($MODULE_NAME, "Buddies in list (" . @buddy_array . "): \n"); | |
| 83 foreach $bud (@buddy_array) { | |
| 84 Gaim::Debug::info($MODULE_NAME, Gaim::BuddyList::Buddy::get_name($bud) . "\n"); | |
| 85 } | |
| 86 } | |
| 87 } | |
| 88 | |
| 89 sub plugin_unload { | |
| 90 my $plugin = shift; | |
| 91 | |
| 92 print "#" x 80 . "\n\n"; | |
| 93 ######### TEST CODE HERE ########## | |
| 94 | |
| 95 print "Testing: Gaim::Find::buddy()..."; | |
| 96 $buddy = Gaim::Find::buddy($account, $TEST_NAME . TEST); | |
| 97 if ($buddy) { | |
| 98 print "ok.\n"; | |
| 99 print "Testing: Gaim::BuddyList::remove_buddy()..."; | |
| 100 Gaim::BuddyList::remove_buddy($buddy); | |
| 101 if (Gaim::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; } | |
| 102 } else { print "fail.\n"; } | |
| 103 | |
| 104 | |
| 105 print "\n\n" . "#" x 80 . "\n\n"; | |
| 106 } | |
| 107 |
