# HG changeset patch # User John H. Kelm # Date 1122644280 0 # Node ID 0e9e2b923d09a67a2ad613513b389c07ba0cca1a # Parent 778d5464a9b8e8a7bb341863781675ef0736515f [gaim-migrate @ 13271] Fixed some bugs and made some additions to the XSUBS. Added some of my test scripts which are incomplete, but mostly functional. GaimPluginPrefs and GaimGtkPluginPrefs--using evals to do the Gtk widgets with gtk2-perl--work. Plugin actions can now be added, but only one for now. committer: Tailor Script diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/Conversation.xs --- a/plugins/perl/common/Conversation.xs Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/Conversation.xs Fri Jul 29 13:38:00 2005 +0000 @@ -68,7 +68,10 @@ OUTPUT: RETVAL - +int +gaim_conv_window_add_conversation(win, conv) + Gaim::ConvWindow win + Gaim::Conversation conv MODULE = Gaim::Conv PACKAGE = Gaim::Conv PREFIX = gaim_conversation_ @@ -225,9 +228,18 @@ gaim_conversation_update(conv, type) Gaim::Conversation conv Gaim::ConvUpdateType type - + +Gaim::Conversation +gaim_conversation_new(type, account, name) + Gaim::ConversationType type + Gaim::Account account + const char *name - +void +gaim_conversation_set_account(conv, account); + Gaim::Conversation conv + Gaim::Account account + MODULE = Gaim::Conv PACKAGE = Gaim::Conv::IM PREFIX = gaim_conv_im_ @@ -300,9 +312,13 @@ Gaim::Conversation::IM im const char *message - - - +void +gaim_conv_im_write(im, who, message, flags, mtime) + Gaim::Conversation::IM im + const char *who + const char *message + Gaim::MessageFlags flags + time_t mtime MODULE = Gaim::Conv PACKAGE = Gaim::Conv PREFIX = gaim_conv_ diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/Plugin.xs --- a/plugins/perl/common/Plugin.xs Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/Plugin.xs Fri Jul 29 13:38:00 2005 +0000 @@ -4,6 +4,7 @@ PROTOTYPES: ENABLE + void gaim_plugin_destroy(plugin) Gaim::Plugin plugin diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/PluginPref.xs --- a/plugins/perl/common/PluginPref.xs Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/PluginPref.xs Fri Jul 29 13:38:00 2005 +0000 @@ -127,5 +127,12 @@ Gaim::PluginPref pref Gaim::PluginPrefType type CODE: - gaim_plugin_pref_set_type(pref, type); + GaimPluginPrefType gpp_type = GAIM_PLUGIN_PREF_NONE; + if (type == 1) { + gpp_type = GAIM_PLUGIN_PREF_CHOICE; + } else if (type == 2) { + gpp_type = GAIM_PLUGIN_PREF_INFO; + } + gaim_plugin_pref_set_type(pref, gpp_type); + diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/Request.xs --- a/plugins/perl/common/Request.xs Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/Request.xs Fri Jul 29 13:38:00 2005 +0000 @@ -1,9 +1,60 @@ #include "module.h" +typedef struct { + char *cancel_cb; + char *ok_cb; +} GaimPerlRequestData; + +/********************************************************/ +/* */ +/* Callback function that calls a perl subroutine */ +/* */ +/* The void * field data is being used as a way to hide */ +/* the perl sub's name in a GaimPerlRequestData */ +/* */ +/********************************************************/ +void gaim_perl_request_ok_cb(void * data, GaimRequestFields *fields) { + + GaimPerlRequestData *gpr = (GaimPerlRequestData *)data; + + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + + XPUSHs(gaim_perl_bless_object(fields, "Gaim::Request::Fields")); + PUTBACK; + + call_pv(gpr->ok_cb, G_EVAL | G_SCALAR); + SPAGAIN; + + PUTBACK; + FREETMPS; + LEAVE; +} + +void gaim_perl_request_cancel_cb(void * data, GaimRequestFields *fields) { + + GaimPerlRequestData *gpr = (GaimPerlRequestData *)data; + + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + + XPUSHs(gaim_perl_bless_object(fields, "Gaim::Request::Fields")); + PUTBACK; + call_pv(gpr->cancel_cb, G_EVAL | G_SCALAR); + SPAGAIN; + + PUTBACK; + FREETMPS; + LEAVE; +} + + /* TODO -void * -gaim_request_fields(handle, title, primary, secondary, fields, ok_text, ok_cb, cancel_text, cancel_cb, user_data) void * gaim_request_input(handle, title, primary, secondary, default_value, multiline, masked, hint, ok_text, ok_cb, cancel_text, cancel_cb, user_data) @@ -34,6 +85,42 @@ MODULE = Gaim::Request PACKAGE = Gaim::Request PREFIX = gaim_request_ PROTOTYPES: ENABLE +void * +gaim_request_fields(handle, title, primary, secondary, fields, ok_text, ok_cb, cancel_text, cancel_cb) + Gaim::Plugin handle + const char * title + const char * primary + const char * secondary + Gaim::Request::Fields fields + const char * ok_text + SV * ok_cb + const char * cancel_text + SV * cancel_cb +CODE: + GaimPerlRequestData *gpr; + STRLEN len; + char *basename, *package; + + basename = g_path_get_basename(handle->path); + gaim_perl_normalize_script_name(basename); + package = g_strdup_printf("Gaim::Script::%s", basename); + gpr = g_new(GaimPerlRequestData, 1); + gpr->ok_cb = g_strdup_printf("%s::%s", package, SvPV(ok_cb, len)); + gpr->cancel_cb = g_strdup_printf("%s::%s", package, SvPV(cancel_cb, len)); + + RETVAL = gaim_request_fields(handle, title, primary, secondary, fields, ok_text, G_CALLBACK(gaim_perl_request_ok_cb), cancel_text, G_CALLBACK(gaim_perl_request_cancel_cb), gpr); +OUTPUT: + RETVAL + + + + + + + + + + void * gaim_request_action_varg(handle, title, primary, secondary, default_action, user_data, action_count, actions) diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/Status.xs --- a/plugins/perl/common/Status.xs Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/Status.xs Fri Jul 29 13:38:00 2005 +0000 @@ -45,6 +45,7 @@ */ +/***************************XS Code Status.xs**************************/ MODULE = Gaim::Status PACKAGE = Gaim::Presence PREFIX = gaim_presence_ PROTOTYPES: ENABLE @@ -359,7 +360,9 @@ STRLEN t_sl; t_GL = g_list_append(t_GL, SvPV(*av_fetch((AV *)SvRV(status_types), i, 0), t_sl)); } - gaim_status_type_find_with_id(t_GL, id); + RETVAL = (GaimStatusType *)gaim_status_type_find_with_id(t_GL, id); +OUTPUT: + RETVAL Gaim::StatusAttr gaim_status_type_get_attr(status_type, id) diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/module.h --- a/plugins/perl/common/module.h Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/module.h Fri Jul 29 13:38:00 2005 +0000 @@ -169,7 +169,7 @@ typedef GaimPluginInfo * Gaim__PluginInfo; typedef GaimPluginUiInfo * Gaim__PluginUiInfo; typedef GaimPluginLoaderInfo * Gaim__PluginLoaderInfo; -typedef GaimPluginAction * Gaim__PluginAction; +typedef GaimPluginAction * Gaim__Plugin__Action; /* pluginpref.h */ typedef GaimPluginPrefFrame * Gaim__PluginPrefFrame; diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/common/typemap --- a/plugins/perl/common/typemap Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/common/typemap Fri Jul 29 13:38:00 2005 +0000 @@ -144,6 +144,7 @@ Gaim::Status T_GaimObj Gaim::StatusType T_GaimObj +const Gaim::StatusType T_GaimObj Gaim::StatusAttr T_GaimObj Gaim::Presence T_GaimObj Gaim::PresenceContext T_IV diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/perl-common.c --- a/plugins/perl/perl-common.c Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/perl-common.c Fri Jul 29 13:38:00 2005 +0000 @@ -7,6 +7,23 @@ static GHashTable *object_stashes = NULL; +void gaim_perl_normalize_script_name(char *name) +{ + char *c; + + c = strrchr(name, '.'); + + if (c != NULL) + *c = '\0'; + + for (c = name; *c != '\0'; c++) + { + if (*c != '_' && !g_ascii_isalnum(*c)) + *c = '_'; + } +} + + static int magic_free_object(pTHX_ SV *sv, MAGIC *mg) { diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/perl-common.h --- a/plugins/perl/perl-common.h Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/perl-common.h Fri Jul 29 13:38:00 2005 +0000 @@ -23,6 +23,9 @@ gaim_perl_callXS(boot_Gaim__##x, cv, mark); \ } +void gaim_perl_normalize_script_name(char *name); + + SV *newSVGChar(const char *str); void gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark); diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/perl-handlers.c Fri Jul 29 13:38:00 2005 +0000 @@ -4,23 +4,113 @@ #include "debug.h" #include "signals.h" + static GList *timeout_handlers = NULL; static GList *signal_handlers = NULL; static char *perl_plugin_pref_cb; +static char *perl_gtk_plugin_pref_cb; extern PerlInterpreter *my_perl; +/* For now a plugin can only have one action */ +void gaim_perl_plugin_action_cb(GaimPluginAction * gpa) { + + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + + /* We put the plugin handle on the stack so it can pass it along */ + /* to anythng called from the callback. It is supposed to pass */ + /* the Action, but there is no way to access the plugin handle from */ + /* the GaimPluginAction in perl...yet. */ + + XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin")); + PUTBACK; + + /* gaim_perl_plugin_action_callback_sub defined in the header is set */ + /* in perl.c during plugin probe by a PLUGIN_INFO hash value limiting */ + /* us to only one action for right now even though the action member of */ + /* GaimPluginInfo can take (does take) a GList. */ + call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR); + SPAGAIN; + + PUTBACK; + FREETMPS; + LEAVE; +} + +GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) { + GaimPluginAction *act = NULL; + GList *gl = NULL; + + /* TODO: Fix the way we create action handlers so we can have mroe than */ + /* one action in perl. Maybe there is a clever work around, but so far */ + /* I have not figured it out. There is no way to tie the perl sub's */ + /* name to the callback function without these global variables and */ + /* there is no way to create a callback on the fly so each would have */ + /* to be hardcoded--more than one would just be arbitrary. */ + act = gaim_plugin_action_new(gaim_perl_plugin_action_label, gaim_perl_plugin_action_cb); + gl = g_list_append(gl, act); + + return gl; +} + + +GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb) { + + GaimGtkPluginUiInfo *ui_info; + + ui_info = g_new0(GaimGtkPluginUiInfo, 1); + perl_gtk_plugin_pref_cb = g_strdup(frame_cb); + ui_info->get_config_frame = gaim_perl_gtk_get_plugin_frame; + + return ui_info; +} + +GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) { + + SV * sv; + GtkWidget *ret; + MAGIC *mg; + dSP; + int count; + + ENTER; + SAVETMPS; + + count = call_pv(perl_gtk_plugin_pref_cb, G_SCALAR | G_NOARGS); + if (count != 1) + croak("call_pv: Did not return the correct number of values.\n"); + + /* the frame was created in a perl sub and is returned */ + SPAGAIN; + + /* We have a Gtk2::Frame on top of the stack */ + sv = POPs; + + /* The magic field hides the pointer to the actuale GtkWidget */ + mg = mg_find(SvRV(sv), PERL_MAGIC_ext); + ret = (GtkWidget *)mg->mg_ptr; + + PUTBACK; + FREETMPS; + LEAVE; + + return ret; +} + + + /* Called to create a pointer to GaimPluginUiInfo for the GaimPluginInfo */ /* It will then inturn create ui_info with the C function pointer */ /* that will eventually do a call_pv to call a perl functions so users */ /* can create their own frames in the prefs */ -GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb) { +GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb) { GaimPluginUiInfo *ui_info; ui_info = g_new0(GaimPluginUiInfo, 1); - - perl_plugin_pref_cb = frame_cb; - + perl_plugin_pref_cb = g_strdup(frame_cb); ui_info->get_plugin_pref_frame = gaim_perl_get_plugin_frame; return ui_info; @@ -53,7 +143,7 @@ PUTBACK; FREETMPS; LEAVE; - + return ret_frame; } diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/perl-handlers.h --- a/plugins/perl/perl-handlers.h Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/perl-handlers.h Fri Jul 29 13:38:00 2005 +0000 @@ -4,6 +4,13 @@ #include "plugin.h" #include "prefs.h" #include "pluginpref.h" +#include "gtkplugin.h" +#include "gtkutils.h" + +/* TODO: Find a better way to access the perl names from the plugin prober */ +/* and store them for gaim_perl_plugin_action_* functions. */ +char * gaim_perl_plugin_action_callback_sub; +char * gaim_perl_plugin_action_label; typedef struct { @@ -24,9 +31,15 @@ } GaimPerlSignalHandler; -GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb); +void gaim_perl_plugin_action_cb(GaimPluginAction * gpa); +GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context); + +GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb); GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin); +GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb); +GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin); + void gaim_perl_timeout_add(GaimPlugin *plugin, int seconds, SV *callback, SV *data); void gaim_perl_timeout_clear_for_plugin(GaimPlugin *plugin); diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/perl.c --- a/plugins/perl/perl.c Fri Jul 29 05:05:52 2005 +0000 +++ b/plugins/perl/perl.c Fri Jul 29 13:38:00 2005 +0000 @@ -102,7 +102,6 @@ char *package; char *load_sub; char *unload_sub; - } GaimPerlScript; @@ -222,23 +221,6 @@ PUTBACK; } -static void -normalize_script_name(char *name) -{ - char *c; - - c = strrchr(name, '.'); - - if (c != NULL) - *c = '\0'; - - for (c = name; *c != '\0'; c++) - { - if (*c != '_' && !g_ascii_isalnum(*c)) - *c = '_'; - } -} - static gboolean probe_perl_plugin(GaimPlugin *plugin) { @@ -301,7 +283,7 @@ gps->plugin = plugin; basename = g_path_get_basename(plugin->path); - normalize_script_name(basename); + gaim_perl_normalize_script_name(basename); gps->package = g_strdup_printf("Gaim::Script::%s", basename); g_free(basename); @@ -309,9 +291,12 @@ key = hv_fetch(plugin_info, "name", strlen("name"), 0); info->name = g_strdup(SvPV(*key, len)); + if ((key = hv_fetch(plugin_info, "GTK_UI", strlen("GTK_UI"), 0))) + info->ui_requirement = GAIM_GTK_PLUGIN_TYPE; + if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) info->homepage = g_strdup(SvPV(*key, len)); - + if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) info->author = g_strdup(SvPV(*key, len)); @@ -334,10 +319,46 @@ gps->unload_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)); + /********************************************************/ + /* Only one of the next two options should be present */ + /* */ + /* prefs_info - Uses non-GUI (read GTK) gaim API calls */ + /* and creates a GaimPluginPrefInfo type. */ + /* */ + /* gtk_prefs_info - Requires gtk2-perl be installed by */ + /* the user and he must create a GtkWidget */ + /* representing the plugin preferences */ + /* page. */ + /********************************************************/ if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) { /* key now is the name of the Perl sub that will create a frame for us */ info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); } + + if ((key = hv_fetch(plugin_info, "gtk_prefs_info", strlen("gtk_prefs_info"), 0))) { + /* key now is the name of the Perl sub that will create a frame for us */ + info->ui_info = gaim_perl_gtk_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); + } + + /********************************************************/ + /* */ + /* plugin_action - This is given to the plugin info */ + /* as the action GList. There are two parts */ + /* so the user can set the title as it will appear */ + /* in the plugin action menu. The name is */ + /* extracted and then the callback perl sub's name */ + /* both of which then are handled by an internal */ + /* gaim_perl function that sets up the single cb */ + /* function which is then inserted into 'info'. */ + /********************************************************/ + if ((key = hv_fetch(plugin_info, "plugin_action_label", strlen("plugin_action_label"), 0))) { + gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len)); + } + + if ((key = hv_fetch(plugin_info, "plugin_action", strlen("plugin_action"), 0))) { + gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)); + info->actions = gaim_perl_plugin_action; + } plugin->info = info; info->extra_info = gps; @@ -345,7 +366,7 @@ status = gaim_plugin_register(plugin); } } - + perl_destruct(prober); perl_free(prober); diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/account.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/account.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,112 @@ +$MODULE_NAME = "Account Functions Test"; + +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 "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; +} + + +# 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"; + Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Started."); + print "\n\n"; + + + ################################# + # # + # Gaim::Account::Option # + # # + ################################# + + print "Testing: Gaim::Account::Option::new...\n"; + $account_opt = Gaim::Account::Option::new(1, "TEXT", "pref_name"); + Gaim::Account::Option::bool_new("TeXt", "MYprefName", 1); + + ################################# + # # + # Gaim::Account # + # # + ################################# + + + print "Testing: Gaim::Account::new()..."; + $account = Gaim::Account::new($TEST_NAME, $PROTOCOL_ID); + if ($account) { print "ok.\n"; } else { print "fail.\n"; } + + print "Testing: Gaim::Account::add()..."; + Gaim::Accounts::add($account); + print "pending find...\n"; + + 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 = Gaim::Account::get_username($account); + if ($user_name) { print $user_name . "...ok.\n"; } else { print "fail.\n"; } + + + print "Testing: Gaim::Account::is_connected()"; + $user_connected = Gaim::Account::is_connected($account); + if (!($user_connected)) { print "...not connected...ok..\n"; } else { print "...connected...ok.\n"; } + + + print "Testing: Gaim::Accounts::get_active_status()..."; + $status = Gaim::Account::get_active_status($account); + if ($status) { print "ok.\n"; } else { print "fail.\n"; } + + $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); + print "Testing: Gaim::Accounts::connect()...pending...\n"; + + Gaim::Account::set_status($account, "available", TRUE); + Gaim::Account::connect($account); + + print "\n\n"; + Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed."); + print "\n\n" . "#" x 80 . "\n\n"; +} + +sub plugin_unload { + my $plugin = shift; + + print "#" x 80 . "\n\n"; + Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Started."); + print "\n\n"; + + ######### TEST CODE HERE ########## + + print "\n\n"; + Gaim::debug_info("plugin_unload()", "Testing $MODULE_NAME Completed."); + print "\n\n" . "#" x 80 . "\n\n"; +} + diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/buddy_list.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/buddy_list.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,101 @@ +$MODULE_NAME = "Buddy List Test"; + +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 "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"; + my $TEST_ALIAS = "John Kelm"; + 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"; + + print "PERL: Finding account.\n"; + $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); + + ######### TEST CODE HERE ########## + + print "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()..."; + $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"; } + + print "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::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"; + } + } + + print "#" x 80 . "\n\n"; +} + +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) { + print "ok.\n"; + print "Testing: Gaim::BuddyList::remove_buddy()..."; + Gaim::BuddyList::remove_buddy($buddy); + if (Gaim::Find::buddy($account, $TEST_NAME . TEST)) { print "fail.\n"; } else { print "ok.\n"; } + } else { print "fail.\n"; } + + + print "\n\n" . "#" x 80 . "\n\n"; +} + diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/conversation.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/conversation.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,99 @@ +$MODULE_NAME = "Conversation Test"; + +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 "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"; + my $TEST_ALIAS = "John Kelm"; + 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"; + + print "PERL: Finding account.\n"; + $account = Gaim::Accounts::find($USERNAME, $PROTOCOL_ID); + + ######### TEST CODE HERE ########## + print "Testing Gaim::Conv::new()..."; + $conv1 = Gaim::Conv::new(1, $account, "Test Conv. 1"); + if ($conv) { print "ok.\n"; } else { print "fail.\n"; } + + print "Testing Gaim::Conv::new()..."; + $conv2 = Gaim::Conv::new(1, $account, "Test Conv. 2"); + if ($conv) { print "ok.\n"; } else { print "fail.\n"; } + + print "Testing Gaim::Conv::Window::new()...\n"; + $win = Gaim::Conv::Window::new(); + + print "Testing Gaim::Conv::Window::add_conversation()..."; + $conv_count = Gaim::Conv::Window::add_conversation($win, $conv1); + if ($conv_count) { print "ok..." . $conv_count . " conversations...\n"; } else { print "fail.\n"; } + + print "Testing Gaim::Conv::Window::add_conversation()..."; + $conv_count = Gaim::Conv::Window::add_conversation($win, $conv2); + if ($conv_count) { print "ok..." . $conv_count . " conversations...\n"; } else { print "fail.\n"; } + + print "Testing Gaim::Conv::Window::show()...\n"; + Gaim::Conv::Window::show($win); + + print "Testing Gaim::Conv::get_im_data()...\n"; + $im = Gaim::Conv::get_im_data($conv1); + if ($im) { print "ok.\n"; } else { print "fail.\n"; } + + print "Testing Gaim::Conv::IM::send()...\n"; + Gaim::Conv::IM::send($im, "Message Test."); + + print "Testing Gaim::Conv::IM::write()...\n"; + Gaim::Conv::IM::write($im, "sendingUser", "Message Test.", 0, 0); + + print "#" x 80 . "\n\n"; +} + +sub plugin_unload { + my $plugin = shift; + + print "#" x 80 . "\n\n"; + ######### TEST CODE HERE ########## + + + + print "Testing Gaim::Conv::Window::get_conversation_count()...\n"; + $conv_count = Gaim::Conv::Window::get_conversation_count($win); + print $conv_count; + if ($conv_count > 0) { + print "Testing Gaim::Conv::Window::destroy()...\n"; + Gaim::Conv::Window::destroy($win); + } + + print "\n\n" . "#" x 80 . "\n\n"; +} + diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/count_down.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/count_down.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,89 @@ +use Gaim; + +%PLUGIN_INFO = ( + perl_api_version => 2, + name => "Countdown Info Timer", + version => "0.1", + summary => "Makes a countdown in days from today.", + description => "Long description coming....", + author => "John H. Kelm ", + url => "http://gaim.sourceforge.net/", + + load => "plugin_load", + unload => "plugin_unload" +); + + $GLOBAL_TEST_VAR = "STUFF!"; + +sub plugin_unload { + my $plugin = shift; +} + +sub plugin_init { + return %PLUGIN_INFO; +} + + +sub plugin_load { + my $plugin = shift; + + # Retrieve all the accounts + @accounts = Gaim::Accounts::get_all(); + + print "NUM OF ACCS: " . $accounts . "\n"; + # Search each account's user info for our tag + foreach $acc (@accounts) { + print "IN ACCOUNTS\n"; + $user_info = Gaim::Account::get_user_info($acc); + print "USER INFO 1: " . $user_info . "\n"; + # Find and replace + $user_info =~ /countdown([0-9]+).([0-9]+).([0-9]+)/; + print "Found: " .$1 . " " . $2 . " " . $3 . "\n"; + $days = count_days($1, $2, $3); + $user_info =~ s/countdown(\d\d\d\d).(\d\d).(\d\d)/$days/; + print "USER INFO 2: " . $user_info . "\n"; + # Gaim::Account::set_user_info($acc, $user_info); + + } + + eval ' + use Gtk2 \'-init\'; + use Glib; + $window = Gtk2::Window->new(\'toplevel\'); + $window->set_border_width(10); + $button = Gtk2::Button->new("Hello World"); + $button->signal_connect(clicked => \&hello, $window); + + $window->add($button); + $button->show; + $window->show; + # Gtk2->main; + + 0; + + '; warn $@ if $@; +} + +sub hello { + my ($widget, $window) = @_; + print "Called from sub hello!\n "; + print "Test var: " . $GLOBAL_TEST_VAR . " \n"; + @accounts = Gaim::Accounts::get_all(); + $acc = $accounts[0]; + $user_info = Gaim::Account::get_user_info($acc); + print "USER INFO from sub hello: " . $user_info . "\n"; + $window->destroy; +} + +sub count_days { + ($year, $month, $day) = @_; + + + eval ' + use Time::Local; + $future = timelocal(0,0,0,$day,$month-1,$year); + '; warn $@ if $@; + $today = time(); + $days = int(($future - $today)/(60*60*24)); + return $days; +} diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/gtk_frame_test.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/gtk_frame_test.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,66 @@ +$MODULE_NAME = "GTK Frame Test"; + +use Gaim; + +%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 "http://gaim.sourceforge.net/", + + GTK_UI => TRUE, + gtk_prefs_info => "foo", + load => "plugin_load", + unload => "plugin_unload", +); + + +sub plugin_init { + return %PLUGIN_INFO; +} + +sub button_cb { + my $widget = shift; + my $data = shift; + print "Clicked button with message: " . $data . "\n"; +} + +sub foo { + eval ' + use Glib; + use Gtk2 \'-init\'; + + $frame = Gtk2::Frame->new(\'Gtk Test Frame\'); + $button = Gtk2::Button->new(\'Print Message\'); + + $frame->set_border_width(10); + $button->set_border_width(150); + $button->signal_connect("clicked" => \&button_cb, "Message Text"); + $frame->add($button); + + $button->show(); + $frame->show(); + '; + return $frame; +} + +sub plugin_load { + my $plugin = shift; + print "#" x 80 . "\n"; + + + ######### TEST CODE HERE ########## + + print "$MODULE_NAME: Loading...\n"; + + + Gaim::debug_info("plugin_load()", "Testing $MODULE_NAME Completed."); + print "#" x 80 . "\n\n"; +} + +sub plugin_unload { + +} diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/plugin_pref.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/plugin_pref.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,86 @@ +$MODULE_NAME = "Prefs Functions Test"; +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", + prefs_info => "foo" +); + + # 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 foo { + $frame = Gaim::Pref::frame_new(); + + $ppref = Gaim::Pref::new_with_label("boolean"); + Gaim::Pref::frame_add($frame, $ppref); + + $ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/bool", "Boolean Preference"); + Gaim::Pref::frame_add($frame, $ppref); + + + $ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/choice", "Choice Preference"); + Gaim::Pref::set_type($ppref, 1); + Gaim::Pref::add_choice($ppref, "foo", $frame); + Gaim::Pref::add_choice($ppref, "bar", $frame); + Gaim::Pref::frame_add($frame, $ppref); + + $ppref = Gaim::Pref::new_with_name_and_label("/plugins/core/perl_test/text", "Text Box Preference"); + Gaim::Pref::set_max_length($ppref, 16); + Gaim::Pref::frame_add($frame, $ppref); + + return $frame; +} + +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"; + + + ######### TEST CODE HERE ########## + + Gaim::Prefs::add_none("/plugins/core/perl_test"); + Gaim::Prefs::add_bool("/plugins/core/perl_test/bool", 1); + Gaim::Prefs::add_string("/plugins/core/perl_test/choice", "bar"); + Gaim::Prefs::add_string("/plugins/core/perl_test/text", "Foo"); + + + print "\n\n" . "#" x 80 . "\n\n"; +} + +sub plugin_unload { + my $plugin = shift; + + print "#" x 80 . "\n\n"; + + + ######### TEST CODE HERE ########## + + + print "\n\n" . "#" x 80 . "\n\n"; +} + diff -r 778d5464a9b8 -r 0e9e2b923d09 plugins/perl/scripts/request.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/request.pl Fri Jul 29 13:38:00 2005 +0000 @@ -0,0 +1,109 @@ +$MODULE_NAME = "Request Functions Test"; + +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 "http://sourceforge.net/users/johnhkelm/", + + load => "plugin_load", + unload => "plugin_unload", + plugin_action => "plugin_action_test", + plugin_action_label => "Plugin Action Test Label" +); + + + # 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 ok_cb_test{ + $fields = shift; + print "ok_cb_test: BEGIN\n"; + print "ok_cb_test: Button Click\n"; + print "ok_cb_test: Field Type: " . $fields . "\n"; + $account = Gaim::Request::fields_get_account($fields, "acct_test"); + print "ok_cb_test: Username of selected account: " . Gaim::Account::get_username($account) . "\n"; + $int = Gaim::Request::fields_get_integer($fields, "int_test"); + print "ok_cb_test: Integer Value:" . $int . "\n"; + $choice = Gaim::Request::fields_get_choice($fields, "ch_test"); + print "ok_cb_test: Choice Value:" . $choice . "\n"; + print "ok_cb_test: END\n"; +} + +sub cancel_cb_test{ + print "cancel_cb_test: Button Click\n"; +} + +sub plugin_action_test { + $plugin = shift; + print "plugin_action_cb_test: BEGIN\n"; + plugin_request($plugin); + print "plugin_action_cb_test: END\n"; +} + +sub plugin_load { + my $plugin = shift; + ######### TEST CODE HERE ########## + + +} + +sub plugin_request { + $group = Gaim::Request::field_group_new("Group Name"); + $field = Gaim::Request::field_account_new("acct_test", "Account Text", undef); + Gaim::Request::field_account_set_show_all($field, 0); + Gaim::Request::field_group_add_field($group, $field); + + $field = Gaim::Request::field_int_new("int_test", "Integer Text", 33); + Gaim::Request::field_group_add_field($group, $field); + + # Test field choice + $field = Gaim::Request::field_choice_new("ch_test", "Choice Text", 1); + Gaim::Request::field_choice_add($field, "Choice 0"); + Gaim::Request::field_choice_add($field, "Choice 1"); + Gaim::Request::field_choice_add($field, "Choice 2"); + + Gaim::Request::field_group_add_field($group, $field); + + + $request = Gaim::Request::fields_new(); + Gaim::Request::fields_add_group($request, $group); + + Gaim::Request::fields( + $plugin, + "Request Title!", + "Primary Title", + "Secondary Title", + $request, + "Ok Text", "ok_cb_test", + "Cancel Text", "cancel_cb_test"); +} + +sub plugin_unload { + my $plugin = shift; + print "#" x 80 . "\n"; + ######### TEST CODE HERE ########## + + + + print "\n" . "#" x 80 . "\n"; +} +