Mercurial > pidgin
comparison libgaim/plugins/perl/scripts/request.pl @ 14378:d1d275a95d02
[gaim-migrate @ 17084]
Updated to work with current Perl loader API
committer: Tailor Script <tailor@pidgin.im>
| author | Daniel Atallah <daniel.atallah@gmail.com> |
|---|---|
| date | Wed, 30 Aug 2006 04:19:14 +0000 |
| parents | 60b1bc8dbf37 |
| children | e88aae4f4c40 |
comparison
equal
deleted
inserted
replaced
| 14377:f5f2c3948b48 | 14378:d1d275a95d02 |
|---|---|
| 1 $MODULE_NAME = "Request Functions Test"; | 1 $MODULE_NAME = "Request Functions Test"; |
| 2 | 2 |
| 3 use Gaim; | 3 use Gaim; |
| 4 | 4 |
| 5 # All the information Gaim gets about our nifty plugin | 5 # All the information Gaim gets about our nifty plugin |
| 6 %PLUGIN_INFO = ( | 6 %PLUGIN_INFO = ( |
| 7 perl_api_version => 2, | 7 perl_api_version => 2, |
| 8 name => " Perl: $MODULE_NAME", | 8 name => " Perl: $MODULE_NAME", |
| 9 version => "0.1", | 9 version => "0.1", |
| 10 summary => "Test plugin for the Perl interpreter.", | 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.", | 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>", | 12 author => "John H. Kelm <johnhkelm\@gmail.com>", |
| 13 url => "http://sourceforge.net/users/johnhkelm/", | 13 url => "http://sourceforge.net/users/johnhkelm/", |
| 14 | 14 |
| 15 load => "plugin_load", | 15 load => "plugin_load", |
| 16 unload => "plugin_unload", | 16 unload => "plugin_unload", |
| 17 plugin_action => "plugin_action_test", | 17 plugin_action_sub => "plugin_action_names" |
| 18 plugin_action_label => "Plugin Action Test Label" | 18 ); |
| 19 ); | |
| 20 | 19 |
| 21 | 20 |
| 22 # These names must already exist | 21 # These names must already exist |
| 23 my $GROUP = "UIUC Buddies"; | 22 my $GROUP = "UIUC Buddies"; |
| 24 my $USERNAME = "johnhkelm2"; | 23 my $USERNAME = "johnhkelm2"; |
| 25 | 24 |
| 26 # We will create these on load then destroy them on unload | 25 # We will create these on load then destroy them on unload |
| 27 my $TEST_GROUP = "perlTestGroup"; | 26 my $TEST_GROUP = "perlTestGroup"; |
| 28 my $TEST_NAME = "perlTestName"; | 27 my $TEST_NAME = "perlTestName"; |
| 29 my $TEST_ALIAS = "perlTestAlias"; | 28 my $TEST_ALIAS = "perlTestAlias"; |
| 30 my $PROTOCOL_ID = "prpl-oscar"; | 29 my $PROTOCOL_ID = "prpl-oscar"; |
| 31 | 30 |
| 31 %plugin_actions = ( | |
| 32 "Plugin Action Test Label" => \&plugin_action_test, | |
| 33 ); | |
| 32 | 34 |
| 33 sub plugin_init { | 35 sub plugin_action_names { |
| 34 return %PLUGIN_INFO; | 36 foreach $key (keys %plugin_actions) { |
| 35 } | 37 push @array, $key; |
| 38 } | |
| 36 | 39 |
| 37 sub ok_cb_test{ | 40 return @array; |
| 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 } | 41 } |
| 50 | 42 |
| 51 sub cancel_cb_test{ | 43 sub plugin_init { |
| 52 print "cancel_cb_test: Button Click\n"; | 44 return %PLUGIN_INFO; |
| 45 } | |
| 46 | |
| 47 sub ok_cb_test { | |
| 48 $fields = shift; | |
| 49 | |
| 50 Gaim::Debug::info($MODULE_NAME, "plugin_action_cb_test: BEGIN\n"); | |
| 51 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: BEGIN\n"); | |
| 52 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: Button Click\n"); | |
| 53 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: Field Type: $fields \n"); | |
| 54 $account = Gaim::Request::Fields::get_account($fields, "acct_test"); | |
| 55 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: Username of selected account: " . Gaim::Account::get_username($account) . "\n"); | |
| 56 $int = Gaim::Request::Fields::get_integer($fields, "int_test"); | |
| 57 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: Integer Value: $int \n"); | |
| 58 $choice = Gaim::Request::Fields::get_choice($fields, "ch_test"); | |
| 59 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: Choice Value: $choice \n"); | |
| 60 Gaim::Debug::info($MODULE_NAME, "ok_cb_test: END\n"); | |
| 61 } | |
| 62 | |
| 63 sub cancel_cb_test { | |
| 64 Gaim::Debug::info($MODULE_NAME, "cancel_cb_test: Button Click\n"); | |
| 53 } | 65 } |
| 54 | 66 |
| 55 sub plugin_action_test { | 67 sub plugin_action_test { |
| 56 $plugin = shift; | 68 $plugin = shift; |
| 57 print "plugin_action_cb_test: BEGIN\n"; | 69 Gaim::Debug::info($MODULE_NAME, "plugin_action_cb_test: BEGIN\n"); |
| 58 plugin_request($plugin); | 70 plugin_request($plugin); |
| 59 print "plugin_action_cb_test: END\n"; | 71 Gaim::Debug::info($MODULE_NAME, "plugin_action_cb_test: END\n"); |
| 60 } | 72 } |
| 61 | 73 |
| 62 sub plugin_load { | 74 sub plugin_load { |
| 63 my $plugin = shift; | 75 my $plugin = shift; |
| 64 ######### TEST CODE HERE ########## | 76 ######### TEST CODE HERE ########## |
| 65 | 77 |
| 66 | 78 |
| 67 } | 79 } |
| 68 | 80 |
| 69 sub plugin_request { | 81 sub plugin_request { |
| 70 $group = Gaim::Request::field_group_new("Group Name"); | 82 $group = Gaim::Request::Field::Group::new("Group Name"); |
| 71 $field = Gaim::Request::field_account_new("acct_test", "Account Text", undef); | 83 $field = Gaim::Request::Field::account_new("acct_test", "Account Text", undef); |
| 72 Gaim::Request::field_account_set_show_all($field, 0); | 84 Gaim::Request::Field::account_set_show_all($field, 0); |
| 73 Gaim::Request::field_group_add_field($group, $field); | 85 Gaim::Request::Field::Group::add_field($group, $field); |
| 74 | 86 |
| 75 $field = Gaim::Request::field_int_new("int_test", "Integer Text", 33); | 87 $field = Gaim::Request::Field::int_new("int_test", "Integer Text", 33); |
| 76 Gaim::Request::field_group_add_field($group, $field); | 88 Gaim::Request::Field::Group::add_field($group, $field); |
| 77 | 89 |
| 78 # Test field choice | 90 # Test field choice |
| 79 $field = Gaim::Request::field_choice_new("ch_test", "Choice Text", 1); | 91 $field = Gaim::Request::Field::choice_new("ch_test", "Choice Text", 1); |
| 80 Gaim::Request::field_choice_add($field, "Choice 0"); | 92 Gaim::Request::Field::choice_add($field, "Choice 0"); |
| 81 Gaim::Request::field_choice_add($field, "Choice 1"); | 93 Gaim::Request::Field::choice_add($field, "Choice 1"); |
| 82 Gaim::Request::field_choice_add($field, "Choice 2"); | 94 Gaim::Request::Field::choice_add($field, "Choice 2"); |
| 83 | 95 |
| 84 Gaim::Request::field_group_add_field($group, $field); | 96 Gaim::Request::Field::Group::add_field($group, $field); |
| 85 | 97 |
| 86 | 98 |
| 87 $request = Gaim::Request::fields_new(); | 99 $request = Gaim::Request::Fields::new(); |
| 88 Gaim::Request::fields_add_group($request, $group); | 100 Gaim::Request::Fields::add_group($request, $group); |
| 89 | 101 |
| 90 Gaim::Request::fields( | 102 Gaim::Request::fields( |
| 91 $plugin, | 103 $plugin, |
| 92 "Request Title!", | 104 "Request Title!", |
| 93 "Primary Title", | 105 "Primary Title", |
| 94 "Secondary Title", | 106 "Secondary Title", |
| 95 $request, | 107 $request, |
| 96 "Ok Text", "ok_cb_test", | 108 "Ok Text", "ok_cb_test", |
| 97 "Cancel Text", "cancel_cb_test"); | 109 "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 } | 110 } |
| 109 | 111 |
| 112 sub plugin_unload { | |
| 113 my $plugin = shift; | |
| 114 Gaim::Debug::info($MODULE_NAME, "#" x 80 . "\n"); | |
| 115 ######### TEST CODE HERE ########## | |
| 116 | |
| 117 | |
| 118 Gaim::Debug::info($MODULE_NAME, "\n" . "#" x 80 . "\n"); | |
| 119 } | |
| 120 |
