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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
14192
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
1 $MODULE_NAME = "Buddy List Test";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
2
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
3 use Gaim;
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
4
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
18
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
19
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
20 # These names must already exist
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
21 my $USERNAME = "johnhkelm2";
15104
cb7eef7bf550 [gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents: 14192
diff changeset
22
14192
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
23 # We will create these on load then destroy them on unload
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
24 my $TEST_GROUP = "UConn Buddies";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
25 my $TEST_NAME = "johnhkelm";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
26 my $TEST_ALIAS = "John Kelm";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
27 my $PROTOCOL_ID = "prpl-oscar";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
28
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
33
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
34
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
35 # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
85 }
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
86 }
15104
cb7eef7bf550 [gaim-migrate @ 17890]
Daniel Atallah <daniel.atallah@gmail.com>
parents: 14192
diff changeset
87 }
14192
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
91
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
92 print "#" x 80 . "\n\n";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
93 ######### TEST CODE HERE ##########
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
94
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
95 print "Testing: Gaim::Find::buddy()...";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
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
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
98 print "ok.\n";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
99 print "Testing: Gaim::BuddyList::remove_buddy()...";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
100 Gaim::BuddyList::remove_buddy($buddy);
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
101 if (Gaim::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; }
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
102 } else { print "fail.\n"; }
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
103
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
104
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
105 print "\n\n" . "#" x 80 . "\n\n";
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
106 }
60b1bc8dbf37 [gaim-migrate @ 16863]
Evan Schoenberg <evan.s@dreskin.net>
parents:
diff changeset
107