Mercurial > pidgin
view libpurple/plugins/perl/scripts/account.pl @ 17259:5b38f5ecc49e
Bump to 2.0.2devel. TODO: Decide if this should be 2.1.0
author | Sean Egan <seanegan@gmail.com> |
---|---|
date | Fri, 25 May 2007 17:53:58 +0000 |
parents | 2f8274ce570a |
children | 0646207f360f |
line wrap: on
line source
$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-oscar"; 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"; }