Mercurial > pidgin
annotate libgaim/plugins/perl/scripts/buddy_list.pl @ 15209:ffec45ff82d0
[gaim-migrate @ 17999]
Setting this namespaced attribute will tell the Google Talk servers that we can accept back a JID from the bind result that isn't necessarily related to the one we requested. This allows googlemail.com users to enter gmail.com as their server and still authenticate properly. Technically, we shouldn't need an attribute like this (this is all valid XMPP), but lesser clients might choke on this.
committer: Tailor Script <tailor@pidgin.im>
| author | Sean Egan <seanegan@gmail.com> |
|---|---|
| date | Thu, 14 Dec 2006 22:25:18 +0000 |
| parents | cb7eef7bf550 |
| 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 |
