Mon, 16 Apr 2007 00:44:33 +0000
merge of 'b98e72d4089afb8a1879e5fe9627cfb132ee88de'
and '606a402fea87c797c4b751475228a6f6a5385122'
| 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 |