comparison: libpurple/plugins/perl/scripts/account.pl
libpurple/plugins/perl/scripts/account.pl
- branch
- cpw.khc.msnp14
- changeset 20481
- 65485e2ed8a3
- parent 20472
- 6a6d2ef151e6
- parent 20478
- 46933dc62880
equal
deleted
inserted
replaced
| 20480:df9df972434f | 20481:65485e2ed8a3 |
|---|---|
| 1 $MODULE_NAME = "Account Functions Test"; | |
| 2 | |
| 3 use Purple; | |
| 4 | |
| 5 # All the information Purple 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 $USERNAME = "johnhkelm2"; | |
| 27 | |
| 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 | |
| 33 sub plugin_init { | |
| 34 return %PLUGIN_INFO; | |
| 35 } | |
| 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. | |
| 40 sub plugin_load { | |
| 41 my $plugin = shift; | |
| 42 print "#" x 80 . "\n\n"; | |
| 43 Purple::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Started."); | |
| 44 print "\n\n"; | |
| 45 | |
| 46 | |
| 47 ################################# | |
| 48 # # | |
| 49 # Purple::Account::Option # | |
| 50 # # | |
| 51 ################################# | |
| 52 | |
| 53 print "Testing: Purple::Account::Option::new()...\n"; | |
| 54 $acc_opt = Purple::Account::Option->new(1, "TEXT", "pref_name"); | |
| 55 $acc_opt2 = Purple::Account::Option->bool_new("TeXt", "MYprefName", 1); | |
| 56 | |
| 57 ################################# | |
| 58 # # | |
| 59 # Purple::Account # | |
| 60 # # | |
| 61 ################################# | |
| 62 | |
| 63 | |
| 64 print "Testing: Purple::Account::new()... "; | |
| 65 $account = Purple::Account->new($TEST_NAME, $PROTOCOL_ID); | |
| 66 if ($account) { print "ok.\n"; } else { print "fail.\n"; } | |
| 67 | |
| 68 print "Testing: Purple::Accounts::add()..."; | |
| 69 Purple::Accounts::add($account); | |
| 70 print "pending find...\n"; | |
| 71 | |
| 72 print "Testing: Purple::Accounts::find()..."; | |
| 73 $account = Purple::Accounts::find($TEST_NAME, $PROTOCOL_ID); | |
| 74 if ($account) { print "ok.\n"; } else { print "fail.\n"; } | |
| 75 | |
| 76 print "Testing: Purple::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 } | |
| 83 | |
| 84 print "Testing: Purple::Account::is_connected()... "; | |
| 85 if ($account->is_connected()) { | |
| 86 print " Connected.\n"; | |
| 87 } else { | |
| 88 print " Disconnected.\n"; | |
| 89 } | |
| 90 | |
| 91 print "Testing: Purple::Accounts::get_active_status()... "; | |
| 92 if ($account->get_active_status()) { | |
| 93 print "Okay.\n"; | |
| 94 } else { | |
| 95 print "Failed!\n"; | |
| 96 } | |
| 97 | |
| 98 $account = Purple::Accounts::find($USERNAME, $PROTOCOL_ID); | |
| 99 print "Testing: Purple::Accounts::connect()...pending...\n"; | |
| 100 | |
| 101 $account->set_status("available", TRUE); | |
| 102 $account->connect(); | |
| 103 | |
| 104 print "\n\n"; | |
| 105 Purple::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Completed.\n"); | |
| 106 print "\n\n" . "#" x 80 . "\n\n"; | |
| 107 } | |
| 108 | |
| 109 sub plugin_unload { | |
| 110 my $plugin = shift; | |
| 111 | |
| 112 print "#" x 80 . "\n\n"; | |
| 113 Purple::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Started.\n"); | |
| 114 print "\n\n"; | |
| 115 | |
| 116 ######### TEST CODE HERE ########## | |
| 117 | |
| 118 print "\n\n"; | |
| 119 Purple::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Completed.\n"); | |
| 120 print "\n\n" . "#" x 80 . "\n\n"; | |
| 121 } | |
| 122 |
