Mercurial > pidgin.yaz

changeset 15105:cb7eef7bf550

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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 <tailor@pidgin.im>
author Daniel Atallah <daniel.atallah@gmail.com>
date Mon, 04 Dec 2006 04:52:46 +0000
parents 53f7a4a8ad2a
children b2b0839f57d0
files libgaim/plugins/perl/scripts/account.pl libgaim/plugins/perl/scripts/buddy_list.pl
diffstat 2 files changed, 90 insertions(+), 87 deletions(-) [+]
line wrap: on
line diff
--- 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 <johnhkelm\@gmail.com>", 
-	url => "http://sourceforge.net/users/johnhkelm/", 
-	
-	load => "plugin_load", 
-	unload => "plugin_unload" 
-); 
+	author => "John H. Kelm <johnhkelm\@gmail.com>",
+	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";
 }
 
--- 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 <johnhkelm\@gmail.com>", 
-	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 <johnhkelm\@gmail.com>",
+	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);