Return to ras-load CVS log

Up to [Coherent Logic Development] / RasLoadTester

Annotation of RasLoadTester/ras-load, revision 1.1.1.1

1.1       snw         1: #!/usr/bin/env perl
                      2: 
                      3: use Net::OSCAR;
                      4: use Getopt::Long;
                      5: 
                      6: my $bot_version = "0.0.1";
                      7: my $botsn = '';
                      8: my $botct = 1;
                      9: my $botno = 0;
                     10: my $oscar = '';
                     11: my $online = 0;
                     12: my $room = '';
                     13: 
                     14: sub signon_done
                     15: {
                     16:     my ($oscar) = @_;
                     17:     
                     18:     print "$botsn:  signon done\n";
                     19:     $online = 1;
                     20:     $oscar->chat_join("General", 5);    
                     21: }
                     22: 
                     23: sub chat_joined
                     24: {
                     25:     my($oscar, $chatname, $chat) = @_;
                     26: 
                     27:     $room = $chat;
                     28:     
                     29:     print "$botsn:  chat joined\n";
                     30: }
                     31: 
                     32: sub chat_im_in
                     33: {
                     34: 
                     35: }
                     36: 
                     37: sub im_in
                     38: {
                     39:     my($oscar, $sender, $message, $is_away) = @_;
                     40:     print "$botsn:  message received from $sender\n";
                     41: }
                     42: 
                     43: sub oscar_error
                     44: {
                     45:     my($oscar, $connection, $error, $description, $fatal) = @_;
                     46: 
                     47:     if($fatal != 0) {
                     48:         print "$botsn:  fatal OSCAR error:  $description\n";        
                     49:     }
                     50:     else {
                     51:         print "$botsn:  recoverable OSCAR error: $description\n";
                     52:     }
                     53: }
                     54: 
                     55: sub simulate_load
                     56: {
                     57:     my @services = ('im', 'chat', 'dice');    
                     58:     my $tgtno = 0 + int(rand(($botct + 1) - 0));
                     59:     my $tgtsn = "ldtest$tgtno";
                     60: 
                     61:     my $tgtsvc = $services[rand @services];
                     62:     
                     63:     if($tgtsvc eq "im") {
                     64:         $oscar->send_im($tgtsn, "load test message");
                     65:     }
                     66:     elsif($tgtsvc eq "chat") {
                     67:         if(ref($room) eq "Net::OSCAR::Connection::Chat") {
                     68:             $room->chat_send("load test message");            
                     69:         }
                     70:     }
                     71:     elsif($tgtsvc eq 'dice') {
                     72:         if(ref($room) eq "Net::OSCAR::Connection::Chat") {
                     73:             $room->chat_send("//roll-dice15-sides999");
                     74:         }
                     75:     }
                     76:     sleep 1;
                     77:     
                     78: }
                     79: 
                     80: sub main
                     81: {
                     82:     my $botpw = '';
                     83:     my $botsrv = '';
                     84:     
                     85:     GetOptions("botno=n" => \$botno,
                     86:                "botct=n" => \$botct,
                     87:                "aimpw=s" => \$botpw,
                     88:                "aimhost=s" => \$botsrv)
                     89:         or die("error in command line arguments");
                     90: 
                     91:     $botsn = "ldtest$botno";
                     92:     
                     93:     my %signon = (
                     94:         screenname => $botsn,
                     95:         password => $botpw,
                     96:         host => $botsrv,
                     97:         ); 
                     98: 
                     99:     $oscar = Net::OSCAR->new();
                    100:     my $realno = $botno + 1;
                    101:     
                    102:     print "$botsn: $realno of $botct on host $botsrv\n";   
                    103:     
                    104:     $oscar->set_callback_signon_done(\&signon_done);
                    105:     $oscar->set_callback_chat_joined(\&chat_joined);
                    106:     $oscar->set_callback_chat_im_in(\&chat_im_in);
                    107:     $oscar->set_callback_im_in(\&im_in);
                    108:     $oscar->set_callback_error(\&oscar_error);
                    109:     $oscar->signon(%signon);
                    110: 
                    111:     while(1) {
                    112:         $oscar->do_one_loop();
                    113:         if($online == 1) {
                    114:             simulate_load();
                    115:         }
                    116:     }
                    117: }
                    118: 
                    119: main()
                    120: