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
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