view libpurple/plugins/perl/scripts/account.pl @ 31785:0d94c49f9545

Almost certainly not an issue, but bounds check a strcpy in stun.c (EFF)

$MODULE_NAME = "Account Functions Test";

use Purple;

# All the information Purple 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"
);


	# These names must already exist
	my $USERNAME 		= "johnhkelm2";

	# We will create these on load then destroy them on unload
	my $TEST_NAME	 	= "perlTestName";
	my $PROTOCOL_ID 	= "prpl-aim";


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";
	Purple::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Started.");
	print "\n\n";


	#################################
	#				#
	#	Purple::Account::Option	#
	#				#
	#################################

	print "Testing: Purple::Account::Option::new()...\n";
	$acc_opt  = Purple::Account::Option->new(1, "TEXT", "pref_name");
	$acc_opt2 = Purple::Account::Option->bool_new("TeXt", "MYprefName", 1);

	#################################
	#				#
	#	Purple::Account		#
	#				#
	#################################


	print "Testing: Purple::Account::new()... ";
	$account = Purple::Account->new($TEST_NAME, $PROTOCOL_ID);
	if ($account) { print "ok.\n"; } else { print "fail.\n"; }

	print "Testing: Purple::Accounts::add()...";
	Purple::Accounts::add($account);
	print "pending find...\n";

	print "Testing: Purple::Accounts::find()...";
	$account = Purple::Accounts::find($TEST_NAME, $PROTOCOL_ID);
	if ($account) { print "ok.\n"; } else { print "fail.\n"; }

	print "Testing: Purple::Account::get_username()... ";
	$user_name = $account->get_username();
	if ($user_name) {
		print "Success: $user_name.\n";
	} else {
		print "Failed!\n";
	}

	print "Testing: Purple::Account::is_connected()... ";
	if ($account->is_connected()) {
		print " Connected.\n";
	} else {
		print " Disconnected.\n";
	}

	print "Testing: Purple::Accounts::get_active_status()... ";
	if ($account->get_active_status()) {
		print "Okay.\n";
	} else {
		print "Failed!\n";
	}

	$account = Purple::Accounts::find($USERNAME, $PROTOCOL_ID);
	print "Testing: Purple::Accounts::connect()...pending...\n";

	$account->set_status("available", TRUE);
	$account->connect();

	print "\n\n";
	Purple::Debug::info($MODULE_NAME, "plugin_load() - Testing $MODULE_NAME Completed.\n");
	print "\n\n" . "#" x 80 . "\n\n";
}

sub plugin_unload {
	my $plugin = shift;

	print "#" x 80 . "\n\n";
	Purple::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Started.\n");
	print "\n\n";

	#########  TEST CODE HERE  ##########

	print "\n\n";
	Purple::Debug::info($MODULE_NAME, "plugin_unload() - Testing $MODULE_NAME Completed.\n");
	print "\n\n" . "#" x 80 . "\n\n";
}