comparison: core/plugins/perl/scripts/account.pl
core/plugins/perl/scripts/account.pl
- changeset 14253
- b63ebf84c42b
- parent 12364
- 42b44fed7423
equal
deleted
inserted
replaced
| 14252:d10dda2777a9 | 14253:b63ebf84c42b |
|---|---|
| 1 $MODULE_NAME = "Account Functions 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 " . | |
| 12 "functions that work in the C API still work in the " . | |
| 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.", | |
| 17 author => "John H. Kelm <johnhkelm\@gmail.com>", | |
| 18 url => "http://sourceforge.net/users/johnhkelm/", | |
| 19 | |
| 20 load => "plugin_load", | |
| 21 unload => "plugin_unload" | |
| 22 ); | |
| 23 | |
| 24 | |
| 25 # These names must already exist | |
| 26 my $GROUP = "UIUC Buddies"; | |
| 27 my $USERNAME = "johnhkelm2"; | |
| 28 | |
| 29 # We will create these on load then destroy them on unload | |
| 30 my $TEST_GROUP = "perlTestGroup"; | |
| 31 my $TEST_NAME = "perlTestName"; | |
| 32 my $TEST_ALIAS = "perlTestAlias"; | |
| 33 my $PROTOCOL_ID = "prpl-oscar"; | |
| 34 | |
| 35 | |
| 36 sub plugin_init { | |
| 37 return %PLUGIN_INFO; | |
| 38 } | |
| 39 | |
| 40 | |
| 41 # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded | |
| 42 # Note: The plugin has a reference to itself on top of the argument stack. | |
| 43 sub plugin_load { | |
| 44 my $plugin = shift; | |
| 45 print "#" x 80 . "\n\n"; | |
| 46 Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Started."); | |
| 47 print "\n\n"; | |
| 48 | |
| 49 | |
| 50 ################################# | |
| 51 # # | |
| 52 # Gaim::Account::Option # | |
| 53 # # | |
| 54 ################################# | |
| 55 | |
| 56 print "Testing: Gaim::Account::Option::new()...\n"; | |
| 57 $acc_opt = Gaim::Account::Option->new(1, "TEXT", "pref_name"); | |
| 58 $acc_opt2 = Gaim::Account::Option->bool_new("TeXt", "MYprefName", 1); | |
| 59 | |
| 60 ################################# | |
| 61 # # | |
| 62 # Gaim::Account # | |
| 63 # # | |
| 64 ################################# | |
| 65 | |
| 66 | |
| 67 print "Testing: Gaim::Account::new()... "; | |
| 68 $account = Gaim::Account->new($TEST_NAME, $PROTOCOL_ID); | |
| 69 if ($account) { print "ok.\n"; } else { print "fail.\n"; } | |
| 70 | |
| 71 print "Testing: Gaim::Accounts::add()..."; | |
| 72 Gaim::Accounts::add($account); | |
| 73 print "pending find...\n"; | |
| 74 | |
| 75 print "Testing: Gaim::Accounts::find()..."; | |
| 76 $account = Gaim::Accounts::find($TEST_NAME, $PROTOCOL_ID); | |
| 77 if ($account) { print "ok.\n"; } else { print "fail.\n"; } | |
| 78 | |
| 79 print "Testing: Gaim::Account::get_username()... "; | |
| 80 $user_name = $account->get_username(); | |
| 81 if ($user_name) { | |
| 82 print "Success: $user_name.\n"; | |
| 83 } else { | |
| 84 print "Failed!\n"; | |
| 85 } | |
| 86 | |
| 87 print "Testing: Gaim::Account::is_connected()... "; | |
| 88 if ($account->is_connected()) { | |
| 89 print " Connected.\n"; | |
| 90 } else { | |
| 91 print " Disconnected.\n"; | |
| 92 } | |
| 93 | |
| 94 print "Testing: Gaim::Accounts::get_active_status()... "; | |
| 95 if ($account->get_active_status()) { | |
| 96 print "Okay.\n"; | |
| 97 } else { | |
| 98 print "Failed!\n"; | |
| 99 } | |
| 100 | |
| 101 $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); | |
| 102 print "Testing: Gaim::Accounts::connect()...pending...\n"; | |
| 103 | |
| 104 $account->set_status("available", TRUE); | |
| 105 $account->connect(); | |
| 106 | |
| 107 print "\n\n"; | |
| 108 Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed."); | |
| 109 print "\n\n" . "#" x 80 . "\n\n"; | |
| 110 } | |
| 111 | |
| 112 sub plugin_unload { | |
| 113 my $plugin = shift; | |
| 114 | |
| 115 print "#" x 80 . "\n\n"; | |
| 116 Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Started."); | |
| 117 print "\n\n"; | |
| 118 | |
| 119 ######### TEST CODE HERE ########## | |
| 120 | |
| 121 print "\n\n"; | |
| 122 Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Completed."); | |
| 123 print "\n\n" . "#" x 80 . "\n\n"; | |
| 124 } | |
| 125 |
