comparison: plugins/perl/scripts/request.pl
plugins/perl/scripts/request.pl
- branch
- cpw.khc.msnp14
- changeset 20472
- 6a6d2ef151e6
- parent 13912
- 463b4fa9f067
- parent 20469
- b2836a24d81e
- child 20473
- 91e1b3a49d10
equal
deleted
inserted
replaced
| 13912:463b4fa9f067 | 20472:6a6d2ef151e6 |
|---|---|
| 1 $MODULE_NAME = "Request 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 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 plugin_action => "plugin_action_test", | |
| 18 plugin_action_label => "Plugin Action Test Label" | |
| 19 ); | |
| 20 | |
| 21 | |
| 22 # These names must already exist | |
| 23 my $GROUP = "UIUC Buddies"; | |
| 24 my $USERNAME = "johnhkelm2"; | |
| 25 | |
| 26 # We will create these on load then destroy them on unload | |
| 27 my $TEST_GROUP = "perlTestGroup"; | |
| 28 my $TEST_NAME = "perlTestName"; | |
| 29 my $TEST_ALIAS = "perlTestAlias"; | |
| 30 my $PROTOCOL_ID = "prpl-oscar"; | |
| 31 | |
| 32 | |
| 33 sub plugin_init { | |
| 34 return %PLUGIN_INFO; | |
| 35 } | |
| 36 | |
| 37 sub ok_cb_test{ | |
| 38 $fields = shift; | |
| 39 print "ok_cb_test: BEGIN\n"; | |
| 40 print "ok_cb_test: Button Click\n"; | |
| 41 print "ok_cb_test: Field Type: " . $fields . "\n"; | |
| 42 $account = Gaim::Request::fields_get_account($fields, "acct_test"); | |
| 43 print "ok_cb_test: Username of selected account: " . Gaim::Account::get_username($account) . "\n"; | |
| 44 $int = Gaim::Request::fields_get_integer($fields, "int_test"); | |
| 45 print "ok_cb_test: Integer Value:" . $int . "\n"; | |
| 46 $choice = Gaim::Request::fields_get_choice($fields, "ch_test"); | |
| 47 print "ok_cb_test: Choice Value:" . $choice . "\n"; | |
| 48 print "ok_cb_test: END\n"; | |
| 49 } | |
| 50 | |
| 51 sub cancel_cb_test{ | |
| 52 print "cancel_cb_test: Button Click\n"; | |
| 53 } | |
| 54 | |
| 55 sub plugin_action_test { | |
| 56 $plugin = shift; | |
| 57 print "plugin_action_cb_test: BEGIN\n"; | |
| 58 plugin_request($plugin); | |
| 59 print "plugin_action_cb_test: END\n"; | |
| 60 } | |
| 61 | |
| 62 sub plugin_load { | |
| 63 my $plugin = shift; | |
| 64 ######### TEST CODE HERE ########## | |
| 65 | |
| 66 | |
| 67 } | |
| 68 | |
| 69 sub plugin_request { | |
| 70 $group = Gaim::Request::field_group_new("Group Name"); | |
| 71 $field = Gaim::Request::field_account_new("acct_test", "Account Text", undef); | |
| 72 Gaim::Request::field_account_set_show_all($field, 0); | |
| 73 Gaim::Request::field_group_add_field($group, $field); | |
| 74 | |
| 75 $field = Gaim::Request::field_int_new("int_test", "Integer Text", 33); | |
| 76 Gaim::Request::field_group_add_field($group, $field); | |
| 77 | |
| 78 # Test field choice | |
| 79 $field = Gaim::Request::field_choice_new("ch_test", "Choice Text", 1); | |
| 80 Gaim::Request::field_choice_add($field, "Choice 0"); | |
| 81 Gaim::Request::field_choice_add($field, "Choice 1"); | |
| 82 Gaim::Request::field_choice_add($field, "Choice 2"); | |
| 83 | |
| 84 Gaim::Request::field_group_add_field($group, $field); | |
| 85 | |
| 86 | |
| 87 $request = Gaim::Request::fields_new(); | |
| 88 Gaim::Request::fields_add_group($request, $group); | |
| 89 | |
| 90 Gaim::Request::fields( | |
| 91 $plugin, | |
| 92 "Request Title!", | |
| 93 "Primary Title", | |
| 94 "Secondary Title", | |
| 95 $request, | |
| 96 "Ok Text", "ok_cb_test", | |
| 97 "Cancel Text", "cancel_cb_test"); | |
| 98 } | |
| 99 | |
| 100 sub plugin_unload { | |
| 101 my $plugin = shift; | |
| 102 print "#" x 80 . "\n"; | |
| 103 ######### TEST CODE HERE ########## | |
| 104 | |
| 105 | |
| 106 | |
| 107 print "\n" . "#" x 80 . "\n"; | |
| 108 } | |
| 109 |
