Mercurial > pidgin
annotate libgaim/plugins/perl/scripts/buddy_list.pl @ 15104:cb7eef7bf550
[gaim-migrate @ 17890]
Fix up some of the example perl plugins. They still could use some work, but these will at least load now.
committer: Tailor Script <tailor@pidgin.im>
author | Daniel Atallah <daniel.atallah@gmail.com> |
---|---|
date | Mon, 04 Dec 2006 04:52:46 +0000 |
parents | 60b1bc8dbf37 |
children |
rev | line source |
---|---|
14192 | 1 $MODULE_NAME = "Buddy List Test"; |
2 | |
3 use Gaim; | |
4 | |
5 # All the information Gaim gets about our nifty plugin | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
6 %PLUGIN_INFO = ( |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
7 perl_api_version => 2, |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
8 name => "Perl: $MODULE_NAME", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
9 version => "0.1", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
10 summary => "Test plugin for the Perl interpreter.", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
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.", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
12 author => "John H. Kelm <johnhkelm\@gmail.com>", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
13 url => "http://sourceforge.net/users/johnhkelm/", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
14 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
15 load => "plugin_load", |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
16 unload => "plugin_unload" |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
17 ); |
14192 | 18 |
19 | |
20 # These names must already exist | |
21 my $USERNAME = "johnhkelm2"; | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
22 |
14192 | 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 | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
30 sub plugin_init { |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
31 return %PLUGIN_INFO; |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
32 } |
14192 | 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. | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
37 sub plugin_load { |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
38 my $plugin = shift; |
14192 | 39 |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
40 # This is how we get an account to use in the following tests. You should replace the username |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
41 # with an existing user |
14192 | 42 $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
43 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
44 # Testing a find function: Note Gaim::Find not Gaim::Buddy:find! |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
45 # Furthermore, this should work the same for chats and groups |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
46 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddy()..."); |
14192 | 47 $buddy = Gaim::Find::buddy($account, $TEST_NAME); |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
48 Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
49 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
50 # If you should need the handle for some reason, here is how you do it |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
51 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::get_handle()..."); |
14192 | 52 $handle = Gaim::BuddyList::get_handle(); |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
53 Gaim::Debug::info("", ($handle ? "ok." : "fail.") . "\n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
54 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
55 # This gets the Gaim::BuddyList and references it by $blist |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
56 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::get_blist()..."); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
57 $blist = Gaim::get_blist(); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
58 Gaim::Debug::info("", ($blist ? "ok." : "fail.") . "\n"); |
14192 | 59 |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
60 # This is how you would add a buddy named $TEST_NAME" with the alias $TEST_ALIAS |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
61 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::Buddy::new..."); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
62 $buddy = Gaim::BuddyList::Buddy::new($account, $TEST_NAME, $TEST_ALIAS); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
63 Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
64 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
65 # Here we add the new buddy '$buddy' to the group $TEST_GROUP |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
66 # so first we must find the group |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
67 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::group..."); |
14192 | 68 $group = Gaim::Find::group($TEST_GROUP); |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
69 Gaim::Debug::info("", ($group ? "ok." : "fail.") . "\n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
70 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
71 # To add the buddy we need to have the buddy, contact, group and node for insertion. |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
72 # For this example we can let contact be undef and set the insertion node as the group |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
73 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::add_buddy...\n"); |
14192 | 74 Gaim::BuddyList::add_buddy($buddy, undef, $group, $group); |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
75 |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
76 # The example that follows gives an indication of how an API call that returns a list is handled. |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
77 # In this case the buddies of the account found earlier are retrieved and put in an array '@buddy_array' |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
78 # Further down an accessor method is used, 'get_name()' -- see source for details on the full set of methods |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
79 Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddies...\n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
80 @buddy_array = Gaim::Find::buddies($account, undef); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
81 if (@buddy_array) { |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
82 Gaim::Debug::info($MODULE_NAME, "Buddies in list (" . @buddy_array . "): \n"); |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
83 foreach $bud (@buddy_array) { |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
84 Gaim::Debug::info($MODULE_NAME, Gaim::BuddyList::Buddy::get_name($bud) . "\n"); |
14192 | 85 } |
86 } | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
87 } |
14192 | 88 |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
89 sub plugin_unload { |
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
90 my $plugin = shift; |
14192 | 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); | |
15104
cb7eef7bf550
[gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents:
14192
diff
changeset
|
97 if ($buddy) { |
14192 | 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 |