File:  [Coherent Logic Development] / RasLoadTester / ras-load
Revision 1.1: download - view: text, annotated - select for diffs
Sat Feb 8 23:09:15 2025 UTC (7 weeks, 5 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Initial revision

#!/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()
    

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>