# HG changeset patch # User Daniel Atallah # Date 1165207966 0 # Node ID cb7eef7bf5502b30be6eaa9be0bdf646760ce55e # Parent 53f7a4a8ad2a73f821f957d23e365d918ffa2942 [gaim-migrate @ 17890] Fix up some of the example perl plugins. They still could use some work, but these will at least load now. committer: Tailor Script diff -r 53f7a4a8ad2a -r cb7eef7bf550 libgaim/plugins/perl/scripts/account.pl --- a/libgaim/plugins/perl/scripts/account.pl Mon Dec 04 03:49:34 2006 +0000 +++ b/libgaim/plugins/perl/scripts/account.pl Mon Dec 04 04:52:46 2006 +0000 @@ -3,49 +3,46 @@ use Gaim; # All the information Gaim gets about our nifty plugin -%PLUGIN_INFO = ( - perl_api_version => 2, - name => " Perl: $MODULE_NAME", - version => "0.1", - summary => "Test plugin for the Perl interpreter.", +%PLUGIN_INFO = ( + perl_api_version => 2, + name => "Perl: $MODULE_NAME", + version => "0.1", + summary => "Test plugin for the Perl interpreter.", description => "Implements a set of test proccedures to ensure all " . - "functions that work in the C API still work in the " . + "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.", - author => "John H. Kelm ", - url => "http://sourceforge.net/users/johnhkelm/", - - load => "plugin_load", - unload => "plugin_unload" -); + author => "John H. Kelm ", + url => "http://sourceforge.net/users/johnhkelm/", + + load => "plugin_load", + unload => "plugin_unload" +); # These names must already exist - my $GROUP = "UIUC Buddies"; my $USERNAME = "johnhkelm2"; - + # We will create these on load then destroy them on unload - my $TEST_GROUP = "perlTestGroup"; my $TEST_NAME = "perlTestName"; - my $TEST_ALIAS = "perlTestAlias"; my $PROTOCOL_ID = "prpl-oscar"; -sub plugin_init { - return %PLUGIN_INFO; -} +sub plugin_init { + return %PLUGIN_INFO; +} # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded # Note: The plugin has a reference to itself on top of the argument stack. -sub plugin_load { - my $plugin = shift; +sub plugin_load { + my $plugin = shift; print "#" x 80 . "\n\n"; - Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Started."); + Gaim::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Started."); print "\n\n"; - + ################################# # # @@ -56,7 +53,7 @@ print "Testing: Gaim::Account::Option::new()...\n"; $acc_opt = Gaim::Account::Option->new(1, "TEXT", "pref_name"); $acc_opt2 = Gaim::Account::Option->bool_new("TeXt", "MYprefName", 1); - + ################################# # # # Gaim::Account # @@ -75,7 +72,7 @@ print "Testing: Gaim::Accounts::find()..."; $account = Gaim::Accounts::find($TEST_NAME, $PROTOCOL_ID); if ($account) { print "ok.\n"; } else { print "fail.\n"; } - + print "Testing: Gaim::Account::get_username()... "; $user_name = $account->get_username(); if ($user_name) { @@ -100,26 +97,26 @@ $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); print "Testing: Gaim::Accounts::connect()...pending...\n"; - + $account->set_status("available", TRUE); $account->connect(); print "\n\n"; - Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed."); + Gaim::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Completed.\n"); print "\n\n" . "#" x 80 . "\n\n"; -} +} -sub plugin_unload { - my $plugin = shift; +sub plugin_unload { + my $plugin = shift; print "#" x 80 . "\n\n"; - Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Started."); + Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Started.\n"); print "\n\n"; ######### TEST CODE HERE ########## print "\n\n"; - Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Completed."); + Gaim::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Completed.\n"); print "\n\n" . "#" x 80 . "\n\n"; } diff -r 53f7a4a8ad2a -r cb7eef7bf550 libgaim/plugins/perl/scripts/buddy_list.pl --- a/libgaim/plugins/perl/scripts/buddy_list.pl Mon Dec 04 03:49:34 2006 +0000 +++ b/libgaim/plugins/perl/scripts/buddy_list.pl Mon Dec 04 04:52:46 2006 +0000 @@ -3,24 +3,23 @@ use Gaim; # All the information Gaim gets about our nifty plugin -%PLUGIN_INFO = ( - perl_api_version => 2, - name => " Perl: $MODULE_NAME", - version => "0.1", - summary => "Test plugin for the Perl interpreter.", - 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.", - author => "John H. Kelm ", - url => "http://sourceforge.net/users/johnhkelm/", - - load => "plugin_load", - unload => "plugin_unload" -); +%PLUGIN_INFO = ( + perl_api_version => 2, + name => "Perl: $MODULE_NAME", + version => "0.1", + summary => "Test plugin for the Perl interpreter.", + 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.", + author => "John H. Kelm ", + url => "http://sourceforge.net/users/johnhkelm/", + + load => "plugin_load", + unload => "plugin_unload" +); # These names must already exist - my $GROUP = "UIUC Buddies"; my $USERNAME = "johnhkelm2"; - + # We will create these on load then destroy them on unload my $TEST_GROUP = "UConn Buddies"; my $TEST_NAME = "johnhkelm"; @@ -28,67 +27,74 @@ my $PROTOCOL_ID = "prpl-oscar"; -sub plugin_init { - return %PLUGIN_INFO; -} +sub plugin_init { + return %PLUGIN_INFO; +} # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded # Note: The plugin has a reference to itself on top of the argument stack. -sub plugin_load { - my $plugin = shift; - print "#" x 80 . "\n\n"; +sub plugin_load { + my $plugin = shift; - print "PERL: Finding account.\n"; + # This is how we get an account to use in the following tests. You should replace the username + # with an existing user $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); - - ######### TEST CODE HERE ########## - - print "Testing: Gaim::Find::buddy()..."; + + # Testing a find function: Note Gaim::Find not Gaim::Buddy:find! + # Furthermore, this should work the same for chats and groups + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddy()..."); $buddy = Gaim::Find::buddy($account, $TEST_NAME); - if ($buddy) { print "ok.\n"; } else { print "fail.\n"; } - - print "Testing: Gaim::BuddyList::get_handle()..."; + Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); + + # If you should need the handle for some reason, here is how you do it + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::get_handle()..."); $handle = Gaim::BuddyList::get_handle(); - if ($handle) { print "ok.\n"; } else { print "fail.\n"; } - - print "Testing: Gaim::BuddyList::get_blist()..."; - $blist = Gaim::BuddyList::get_blist(); - if ($blist) { print "ok.\n"; } else { print "fail.\n"; } - - print "Testing: Gaim::Buddy::new..."; - $buddy = Gaim::Buddy::new($account, $TEST_NAME . "TEST", $TEST_ALIAS); - if ($buddy) { print "ok.\n"; } else { print "fail.\n"; } + Gaim::Debug::info("", ($handle ? "ok." : "fail.") . "\n"); + + # This gets the Gaim::BuddyList and references it by $blist + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::get_blist()..."); + $blist = Gaim::get_blist(); + Gaim::Debug::info("", ($blist ? "ok." : "fail.") . "\n"); - print "Testing: Gaim::Find::group..."; + # This is how you would add a buddy named $TEST_NAME" with the alias $TEST_ALIAS + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::Buddy::new..."); + $buddy = Gaim::BuddyList::Buddy::new($account, $TEST_NAME, $TEST_ALIAS); + Gaim::Debug::info("", ($buddy ? "ok." : "fail.") . "\n"); + + # Here we add the new buddy '$buddy' to the group $TEST_GROUP + # so first we must find the group + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::group..."); $group = Gaim::Find::group($TEST_GROUP); - if ($group) { print "ok.\n"; } else { print "fail.\n"; } - - print "Testing: Gaim::BuddyList::add_buddy..."; + Gaim::Debug::info("", ($group ? "ok." : "fail.") . "\n"); + + # To add the buddy we need to have the buddy, contact, group and node for insertion. + # For this example we can let contact be undef and set the insertion node as the group + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::BuddyList::add_buddy...\n"); Gaim::BuddyList::add_buddy($buddy, undef, $group, $group); - if ($buddy) { print "ok.\n"; } else { print "fail.\n"; } - - print "Testing: Gaim::Find::buddies...\n"; - @buddy_array = Gaim::Find::buddies($account, $USERNAME); - if (@buddy_array) { - print "Buddies in list (" . @buddy_array . "): \n"; - foreach $bud (@buddy_array) { - print Gaim::Buddy::get_name($bud) . "\n"; + + # The example that follows gives an indication of how an API call that returns a list is handled. + # In this case the buddies of the account found earlier are retrieved and put in an array '@buddy_array' + # Further down an accessor method is used, 'get_name()' -- see source for details on the full set of methods + Gaim::Debug::info($MODULE_NAME, "Testing: Gaim::Find::buddies...\n"); + @buddy_array = Gaim::Find::buddies($account, undef); + if (@buddy_array) { + Gaim::Debug::info($MODULE_NAME, "Buddies in list (" . @buddy_array . "): \n"); + foreach $bud (@buddy_array) { + Gaim::Debug::info($MODULE_NAME, Gaim::BuddyList::Buddy::get_name($bud) . "\n"); } } +} - print "#" x 80 . "\n\n"; -} - -sub plugin_unload { - my $plugin = shift; +sub plugin_unload { + my $plugin = shift; print "#" x 80 . "\n\n"; ######### TEST CODE HERE ########## print "Testing: Gaim::Find::buddy()..."; $buddy = Gaim::Find::buddy($account, $TEST_NAME . TEST); - if ($buddy) { + if ($buddy) { print "ok.\n"; print "Testing: Gaim::BuddyList::remove_buddy()..."; Gaim::BuddyList::remove_buddy($buddy);