Mon, 04 Dec 2006 04:52:46 +0000
[gaim-migrate @ 17890]
Fix up some of the example perl plugins. They still could use some work, but these will at least load now.
| 11170 | 1 | $MODULE_NAME = "Account Functions Test"; |
| 2 | ||
| 3 | use Gaim; | |
| 4 | ||
| 5 | # All the information Gaim gets about our nifty plugin | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
6 | %PLUGIN_INFO = ( |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
7 | perl_api_version => 2, |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
8 | name => "Perl: $MODULE_NAME", |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
9 | version => "0.1", |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
10 | summary => "Test plugin for the Perl interpreter.", |
| 12364 | 11 | description => "Implements a set of test proccedures to ensure all " . |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
12 | "functions that work in the C API still work in the " . |
| 12364 | 13 | "Perl plugin interface. As XSUBs are added, this " . |
| 14 | "*should* be updated to test the changes. " . | |
| 15 | "Furthermore, this will function as the tutorial perl " . | |
| 16 | "plugin.", | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
17 | author => "John H. Kelm <johnhkelm\@gmail.com>", |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
18 | url => "http://sourceforge.net/users/johnhkelm/", |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
19 | |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
20 | load => "plugin_load", |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
21 | unload => "plugin_unload" |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
22 | ); |
| 11170 | 23 | |
| 24 | ||
| 25 | # These names must already exist | |
| 26 | my $USERNAME = "johnhkelm2"; | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
27 | |
| 11170 | 28 | # We will create these on load then destroy them on unload |
| 29 | my $TEST_NAME = "perlTestName"; | |
| 30 | my $PROTOCOL_ID = "prpl-oscar"; | |
| 31 | ||
| 32 | ||
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
33 | sub plugin_init { |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
34 | return %PLUGIN_INFO; |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
35 | } |
| 11170 | 36 | |
| 37 | ||
| 38 | # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded | |
| 39 | # Note: The plugin has a reference to itself on top of the argument stack. | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
40 | sub plugin_load { |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
41 | my $plugin = shift; |
| 11170 | 42 | print "#" x 80 . "\n\n"; |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
43 | Gaim::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Started."); |
| 11170 | 44 | print "\n\n"; |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
45 | |
| 11170 | 46 | |
| 47 | ################################# | |
| 48 | # # | |
| 49 | # Gaim::Account::Option # | |
| 50 | # # | |
| 51 | ################################# | |
| 52 | ||
| 12364 | 53 | print "Testing: Gaim::Account::Option::new()...\n"; |
| 54 | $acc_opt = Gaim::Account::Option->new(1, "TEXT", "pref_name"); | |
| 55 | $acc_opt2 = Gaim::Account::Option->bool_new("TeXt", "MYprefName", 1); | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
56 | |
| 11170 | 57 | ################################# |
| 58 | # # | |
| 59 | # Gaim::Account # | |
| 60 | # # | |
| 61 | ################################# | |
| 62 | ||
| 63 | ||
| 12364 | 64 | print "Testing: Gaim::Account::new()... "; |
| 65 | $account = Gaim::Account->new($TEST_NAME, $PROTOCOL_ID); | |
| 11170 | 66 | if ($account) { print "ok.\n"; } else { print "fail.\n"; } |
| 67 | ||
| 12364 | 68 | print "Testing: Gaim::Accounts::add()..."; |
| 11170 | 69 | Gaim::Accounts::add($account); |
| 12364 | 70 | print "pending find...\n"; |
| 11170 | 71 | |
| 72 | print "Testing: Gaim::Accounts::find()..."; | |
| 73 | $account = Gaim::Accounts::find($TEST_NAME, $PROTOCOL_ID); | |
| 74 | if ($account) { print "ok.\n"; } else { print "fail.\n"; } | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
75 | |
| 12364 | 76 | print "Testing: Gaim::Account::get_username()... "; |
| 77 | $user_name = $account->get_username(); | |
| 78 | if ($user_name) { | |
| 79 | print "Success: $user_name.\n"; | |
| 80 | } else { | |
| 81 | print "Failed!\n"; | |
| 82 | } | |
| 11170 | 83 | |
| 12364 | 84 | print "Testing: Gaim::Account::is_connected()... "; |
| 85 | if ($account->is_connected()) { | |
| 86 | print " Connected.\n"; | |
| 87 | } else { | |
| 88 | print " Disconnected.\n"; | |
| 89 | } | |
| 11170 | 90 | |
| 12364 | 91 | print "Testing: Gaim::Accounts::get_active_status()... "; |
| 92 | if ($account->get_active_status()) { | |
| 93 | print "Okay.\n"; | |
| 94 | } else { | |
| 95 | print "Failed!\n"; | |
| 96 | } | |
| 11170 | 97 | |
| 98 | $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); | |
| 99 | print "Testing: Gaim::Accounts::connect()...pending...\n"; | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
100 | |
| 12364 | 101 | $account->set_status("available", TRUE); |
| 102 | $account->connect(); | |
| 11170 | 103 | |
| 104 | print "\n\n"; | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
105 | Gaim::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Completed.\n"); |
| 11170 | 106 | print "\n\n" . "#" x 80 . "\n\n"; |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
107 | } |
| 11170 | 108 | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
109 | sub plugin_unload { |
|
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
110 | my $plugin = shift; |
| 11170 | 111 | |
| 112 | print "#" x 80 . "\n\n"; | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
113 | Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Started.\n"); |
| 11170 | 114 | print "\n\n"; |
| 115 | ||
| 116 | ######### TEST CODE HERE ########## | |
| 117 | ||
| 118 | print "\n\n"; | |
|
15166
8febc283dead
[gaim-migrate @ 17890]
Daniel Atallah <datallah@pidgin.im>
parents:
14254
diff
changeset
|
119 | Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Completed.\n"); |
| 11170 | 120 | print "\n\n" . "#" x 80 . "\n\n"; |
| 121 | } | |
| 122 |