#!/usr/bin/env perl use Net::OSCAR; use Getopt::Long; my $bot_version = "0.0.1"; my $botsn = ''; my $botct = 1; my $botno = 0; my $oscar = ''; my $online = 0; my $room = ''; sub signon_done { my ($oscar) = @_; print "$botsn: signon done\n"; $online = 1; $oscar->chat_join("General", 5); } sub chat_joined { my($oscar, $chatname, $chat) = @_; $room = $chat; print "$botsn: chat joined\n"; } sub chat_im_in { } sub im_in { my($oscar, $sender, $message, $is_away) = @_; print "$botsn: message received from $sender\n"; } sub oscar_error { my($oscar, $connection, $error, $description, $fatal) = @_; if($fatal != 0) { print "$botsn: fatal OSCAR error: $description\n"; } else { print "$botsn: recoverable OSCAR error: $description\n"; } } sub simulate_load { my @services = ('im', 'chat', 'dice'); my $tgtno = 0 + int(rand(($botct + 1) - 0)); my $tgtsn = "ldtest$tgtno"; my $tgtsvc = $services[rand @services]; if($tgtsvc eq "im") { $oscar->send_im($tgtsn, "load test message"); } elsif($tgtsvc eq "chat") { if(ref($room) eq "Net::OSCAR::Connection::Chat") { $room->chat_send("load test message"); } } elsif($tgtsvc eq 'dice') { if(ref($room) eq "Net::OSCAR::Connection::Chat") { $room->chat_send("//roll-dice15-sides999"); } } sleep 1; } sub main { my $botpw = ''; my $botsrv = ''; GetOptions("botno=n" => \$botno, "botct=n" => \$botct, "aimpw=s" => \$botpw, "aimhost=s" => \$botsrv) or die("error in command line arguments"); $botsn = "ldtest$botno"; my %signon = ( screenname => $botsn, password => $botpw, host => $botsrv, ); $oscar = Net::OSCAR->new(); my $realno = $botno + 1; print "$botsn: $realno of $botct on host $botsrv\n"; $oscar->set_callback_signon_done(\&signon_done); $oscar->set_callback_chat_joined(\&chat_joined); $oscar->set_callback_chat_im_in(\&chat_im_in); $oscar->set_callback_im_in(\&im_in); $oscar->set_callback_error(\&oscar_error); $oscar->signon(%signon); while(1) { $oscar->do_one_loop(); if($online == 1) { simulate_load(); } } } main()