Wed, 13 May 2009 20:29:03 +0000
Support custom smileys in MUCs (when all participants support BoB and a maximum
of 10 participants are in the chat).
Always announce support for BoB, since disable custom smileys will still turn
off fetching them, and BoB can be used for other purposes further on.
| 11170 | 1 | $MODULE_NAME = "Conversation Test"; |
| 2 | ||
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
3 | use Purple; |
| 11170 | 4 | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
5 | # All the information Purple gets about our nifty plugin |
| 11170 | 6 | %PLUGIN_INFO = ( |
| 7 | perl_api_version => 2, | |
| 12340 | 8 | name => "Perl: $MODULE_NAME", |
| 11170 | 9 | version => "0.1", |
| 10 | summary => "Test plugin for the Perl interpreter.", | |
| 12340 | 11 | description => "Implements a set of test proccedures to ensure all " . |
| 12 | "functions that work in the C API still work in the " . | |
| 13 | "Perl plugin interface. As XSUBs are added, this " . | |
| 14 | "*should* be updated to test the changes. " . | |
| 15 | "Furthermore, this will function as the tutorial perl " . | |
| 16 | "plugin.", | |
|
11457
e787f1445e64
[gaim-migrate @ 13696]
Richard Laager <rlaager@pidgin.im>
parents:
11170
diff
changeset
|
17 | author => "John H. Kelm <johnhkelm\@gmail.com>", |
| 11170 | 18 | url => "http://sourceforge.net/users/johnhkelm/", |
| 19 | ||
| 20 | load => "plugin_load", | |
| 21 | unload => "plugin_unload" | |
| 22 | ); | |
| 23 | ||
| 24 | ||
| 25 | # These names must already exist | |
| 26 | my $GROUP = "UIUC Buddies"; | |
| 27 | my $USERNAME = "johnhkelm2"; | |
| 28 | ||
| 29 | # We will create these on load then destroy them on unload | |
| 30 | my $TEST_GROUP = "UConn Buddies"; | |
| 31 | my $TEST_NAME = "johnhkelm"; | |
| 32 | my $TEST_ALIAS = "John Kelm"; | |
| 33 | my $PROTOCOL_ID = "prpl-oscar"; | |
| 34 | ||
| 35 | ||
| 36 | sub plugin_init { | |
| 37 | return %PLUGIN_INFO; | |
| 38 | } | |
| 39 | ||
| 40 | ||
| 41 | # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded | |
| 42 | # Note: The plugin has a reference to itself on top of the argument stack. | |
| 43 | sub plugin_load { | |
| 44 | my $plugin = shift; | |
| 45 | print "#" x 80 . "\n\n"; | |
| 46 | ||
| 47 | print "PERL: Finding account.\n"; | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
48 | $account = Purple::Accounts::find($USERNAME, $PROTOCOL_ID); |
| 11170 | 49 | |
| 50 | ######### TEST CODE HERE ########## | |
| 12340 | 51 | # First we create two new conversations. |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
52 | print "Testing Purple::Conversation::new()..."; |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
53 | $conv1 = Purple::Conversation->new(1, $account, "Test Conversation 1"); |
| 12340 | 54 | if ($conv1) { print "ok.\n"; } else { print "fail.\n"; } |
| 11170 | 55 | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
56 | print "Testing Purple::Conversation::new()..."; |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
57 | $conv2 = Purple::Conversation->new(1, $account, "Test Conversation 2"); |
| 12340 | 58 | if ($conv2) { print "ok.\n"; } else { print "fail.\n"; } |
| 11170 | 59 | |
| 12340 | 60 | # Second we create a window to display the conversations in. |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
61 | # Note that the package here is Purple::Conversation::Window |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
62 | print "Testing Purple::Conversation::Window::new()...\n"; |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
63 | $win = Purple::Conversation::Window::new(); |
| 11170 | 64 | |
| 12340 | 65 | # The third thing to do is to add the two conversations to the windows. |
| 66 | # The subroutine add_conversation() returns the number of conversations | |
| 67 | # present in the window. | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
68 | print "Testing Purple::Conversation::Window::add_conversation()..."; |
| 12340 | 69 | $conv_count = $conv1->add_conversation(); |
| 70 | if ($conv_count) { | |
| 71 | print "ok..." . $conv_count . " conversations...\n"; | |
| 72 | } else { | |
| 73 | print "fail.\n"; | |
| 74 | } | |
| 75 | ||
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
76 | print "Testing Purple::Conversation::Window::add_conversation()..."; |
| 12340 | 77 | $conv_count = $win->add_conversation($conv2); |
| 78 | if ($conv_count) { | |
| 79 | print "ok..." . $conv_count . " conversations...\n"; | |
| 80 | } else { | |
| 81 | print "fail.\n"; | |
| 82 | } | |
| 83 | ||
| 84 | # Now the window is displayed to the user. | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
85 | print "Testing Purple::Conversation::Window::show()...\n"; |
| 12340 | 86 | $win->show(); |
| 87 | ||
| 88 | # Use get_im_data() to get a handle for the conversation | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
89 | print "Testing Purple::Conversation::get_im_data()...\n"; |
| 12340 | 90 | $im = $conv1->get_im_data(); |
| 11170 | 91 | if ($im) { print "ok.\n"; } else { print "fail.\n"; } |
| 12340 | 92 | |
| 93 | # Here we send messages to the conversation | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
94 | print "Testing Purple::Conversation::IM::send()...\n"; |
| 12340 | 95 | $im->send("Message Test."); |
| 96 | ||
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
97 | print "Testing Purple::Conversation::IM::write()...\n"; |
| 12340 | 98 | $im->write("SENDER", "<b>Message</b> Test.", 0, 0); |
| 11170 | 99 | |
| 100 | print "#" x 80 . "\n\n"; | |
| 101 | } | |
| 102 | ||
| 103 | sub plugin_unload { | |
| 104 | my $plugin = shift; | |
| 105 | ||
| 106 | print "#" x 80 . "\n\n"; | |
| 107 | ######### TEST CODE HERE ########## | |
| 108 | ||
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
109 | print "Testing Purple::Conversation::Window::get_conversation_count()...\n"; |
| 12340 | 110 | $conv_count = $win->get_conversation_count(); |
| 111 | print "...and it returned $conv_count.\n"; | |
| 11170 | 112 | if ($conv_count > 0) { |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
113 | print "Testing Purple::Conversation::Window::destroy()...\n"; |
| 12340 | 114 | $win->destroy(); |
| 11170 | 115 | } |
| 116 | ||
| 117 | print "\n\n" . "#" x 80 . "\n\n"; | |
| 118 | } | |
| 119 |