plugins/perl/scripts/buddy_list.pl

changeset 14253
b63ebf84c42b
parent 14252
d10dda2777a9
child 14254
77edc7a6191a
equal deleted inserted replaced
14252:d10dda2777a9 14253:b63ebf84c42b
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 $GROUP = "UIUC Buddies";
22 my $USERNAME = "johnhkelm2";
23
24 # We will create these on load then destroy them on unload
25 my $TEST_GROUP = "UConn Buddies";
26 my $TEST_NAME = "johnhkelm";
27 my $TEST_ALIAS = "John Kelm";
28 my $PROTOCOL_ID = "prpl-oscar";
29
30
31 sub plugin_init {
32 return %PLUGIN_INFO;
33 }
34
35
36 # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
37 # Note: The plugin has a reference to itself on top of the argument stack.
38 sub plugin_load {
39 my $plugin = shift;
40 print "#" x 80 . "\n\n";
41
42 print "PERL: Finding account.\n";
43 $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID);
44
45 ######### TEST CODE HERE ##########
46
47 print "Testing: Gaim::Find::buddy()...";
48 $buddy = Gaim::Find::buddy($account, $TEST_NAME);
49 if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }
50
51 print "Testing: Gaim::BuddyList::get_handle()...";
52 $handle = Gaim::BuddyList::get_handle();
53 if ($handle) { print "ok.\n"; } else { print "fail.\n"; }
54
55 print "Testing: Gaim::BuddyList::get_blist()...";
56 $blist = Gaim::BuddyList::get_blist();
57 if ($blist) { print "ok.\n"; } else { print "fail.\n"; }
58
59 print "Testing: Gaim::Buddy::new...";
60 $buddy = Gaim::Buddy::new($account, $TEST_NAME . "TEST", $TEST_ALIAS);
61 if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }
62
63 print "Testing: Gaim::Find::group...";
64 $group = Gaim::Find::group($TEST_GROUP);
65 if ($group) { print "ok.\n"; } else { print "fail.\n"; }
66
67 print "Testing: Gaim::BuddyList::add_buddy...";
68 Gaim::BuddyList::add_buddy($buddy, undef, $group, $group);
69 if ($buddy) { print "ok.\n"; } else { print "fail.\n"; }
70
71 print "Testing: Gaim::Find::buddies...\n";
72 @buddy_array = Gaim::Find::buddies($account, $USERNAME);
73 if (@buddy_array) {
74 print "Buddies in list (" . @buddy_array . "): \n";
75 foreach $bud (@buddy_array) {
76 print Gaim::Buddy::get_name($bud) . "\n";
77 }
78 }
79
80 print "#" x 80 . "\n\n";
81 }
82
83 sub plugin_unload {
84 my $plugin = shift;
85
86 print "#" x 80 . "\n\n";
87 ######### TEST CODE HERE ##########
88
89 print "Testing: Gaim::Find::buddy()...";
90 $buddy = Gaim::Find::buddy($account, $TEST_NAME . TEST);
91 if ($buddy) {
92 print "ok.\n";
93 print "Testing: Gaim::BuddyList::remove_buddy()...";
94 Gaim::BuddyList::remove_buddy($buddy);
95 if (Gaim::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; }
96 } else { print "fail.\n"; }
97
98
99 print "\n\n" . "#" x 80 . "\n\n";
100 }
101

mercurial