You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
92 lines
2.7 KiB
92 lines
2.7 KiB
# ----------------------------------------------------------------------------- |
|
# tktest.pl |
|
# Desc: Testing runmode; loads and intializes the Tk interface |
|
# ----------------------------------------------------------------------------- |
|
|
|
use Milkbone qw(load_plugin); |
|
use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop |
|
post_mainloop protocol_signon); |
|
|
|
Milkbone->init; |
|
|
|
load_plugin "Tk-GUI"; |
|
|
|
load_plugin "Tk-About"; |
|
load_plugin "Tk-AddBuddy"; |
|
load_plugin "Tk-BList"; |
|
load_plugin "Tk-Convo"; |
|
load_plugin "Tk-Chat"; |
|
load_plugin "Tk-Conf"; |
|
load_plugin "Tk-File"; |
|
load_plugin "Tk-Logon"; |
|
load_plugin "Tk-PluginsConf"; |
|
load_plugin "Tk-Profile"; |
|
|
|
# begin unit testing code |
|
|
|
register_hook "protocol_signon", sub { |
|
hook("after", -time => 10, -code => sub { hook("signed_in") }); |
|
|
|
register_hook "protocol_add_buddy", sub { hook("buddy_in", |
|
-buddy => $ARGS{-buddy}, |
|
-group => $ARGS{-group}); }; |
|
|
|
register_hook "protocol_get_groups", sub { return ["Buddies", "You"] }; |
|
register_hook "protocol_get_realname", sub { return lc $ARGS{-user} }; |
|
register_hook "protocol_request_info", sub { |
|
hook("after", -time => 1000, -code => sub { |
|
hook("protocol_info_received_$ARGS{-user}", |
|
-profile => 'test', -away => 'test'); |
|
}); |
|
}; |
|
|
|
register_hook "protocol_send_im", sub { |
|
hook("after", -time => 500, -code => [sub { |
|
hook("msg_sent_$_[0]", |
|
-user => $_[0], |
|
-msg => $_[1], |
|
-away => 0); |
|
hook("after", -time => 500, sub { |
|
hook("msg_in", -user => $_[0], |
|
-msg => $_[1], -away => 0); |
|
hook("msg_in_$_[0]", -user => $_[0], |
|
-msg => $_[1], -away => 0); |
|
}); |
|
}, $ARGS{-dest}, $ARGS{-msg}]); |
|
}; |
|
register_hook "protocol_away_status", sub { 0 }; |
|
|
|
hook("after", -time => 1000, -code => sub { |
|
hook("buddy_in", -group => 'Buddies', -buddy => 'test_user'); |
|
}); |
|
|
|
# hook("after", -time => 1000, -code => sub { |
|
# hook("msg_in", -user => 'thatguy', -msg => '<b>hey</b>'); |
|
# }); |
|
|
|
# hook("after", -time => 1500, -code => sub { |
|
# hook("protocol_send_im", -dest => 'thatguy', |
|
# -msg => '<b>hey there</b>'); |
|
|
|
hook("after", -time => 500, -code => sub { |
|
register_hook "protocol_chat_accept", sub { |
|
hook("protocol_chat_joined", -name => 'erer', -user => 'er', |
|
-url => 'ere'); |
|
hook("protocol_chat_buddy_in_ere", -user => 'charles'); |
|
}; |
|
|
|
hook("protocol_chat_invited", -user => 'thatguy', |
|
-url => 'er'); |
|
}); |
|
}; |
|
|
|
protocol_signon -user => 'test', -pass => 'test'; |
|
data("me") = "lala"; |
|
|
|
# end unit testing code |
|
|
|
pre_mainloop; |
|
mainloop; |
|
post_mainloop; |
|
|
|
return 1;
|
|
|