1#!/usr/local/bin/perl -w 2# 3# $Id: load-test.pl,v 1.4 2004/12/05 11:34:18 chris Exp $ 4# 5# This is an adaption of Dennis Taylor's test.pl. It combines a very 6# simple bot with Chatbot::Eliza to make something fairly annoying. 7# -- Rocco Caputo, <troc+pci@netrus.net> 8 9use strict; 10 11use POE::Kernel; 12use POE::Session; 13use POE::Component::IRC; 14use Chatbot::Eliza; 15use Getopt::Long; 16 17my $server; 18my $port; 19my $nick = 'ClInt^'; 20my $ircname = 'PoCo-Server-IRC Load Test Script'; 21my $bots = 10; 22my $chans = 1; 23my $flood = 0; 24my $debug = 0; 25 26GetOptions( "server=s" => \$server, 27 "port=i" => \$port, 28 "nick=s" => \$nick, 29 "bots=i" => \$bots, 30 "chans=i" => \$chans, 31 "flood=i" => \$flood, 32); 33 34my $eliza = Chatbot::Eliza->new(); 35 36# here's where execution starts. 37my @ircs; 38foreach my $counter (1..$bots){ 39 my $irc = POE::Component::IRC->spawn( alias => $nick . $counter ) or 40 die "Can't instantiate new IRC component!\n"; 41 push @ircs, $irc; 42} 43POE::Session->create( package_states => [ 'main' => 44 [ qw( _start _stop irc_001 irc_disconnected irc_join 45 irc_error irc_socketerr irc_public delayed_connect 46 ) 47 ] ], 48 heap => { ircs => \@ircs }, 49 ); 50$poe_kernel->run(); 51 52exit 0; 53 54# This gets executed as soon as the kernel sets up this session. 55sub _start { 56 my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; 57 58 # Uncomment this to turn on more verbose POE debugging information. 59 # $session->option( trace => 1 ); 60 61 # Ask the IRC component to send us all IRC events it receives. This 62 # is the easy, indiscriminate way to do it. 63 64 foreach my $irc ( @{ $heap->{ircs} } ) { 65 $irc->yield( register => 'all'); 66 67 # Setting Debug to 1 causes P::C::IRC to print all raw lines of text 68 # sent to and received from the IRC server. Very useful for debugging. 69 $irc->yield( 'connect' => { Debug => $debug, 70 Nick => $nick . $irc->session_id(), 71 Server => $server || 'localhost', 72 Port => $port || 6667, 73 Username => $nick, 74 Ircname => $ircname, 75 Flood => $flood, 76 } 77 78 ); 79 } 80 undef; 81} 82 83sub delayed_connect { 84 my ($kernel,$counter,$hashref) = @_[KERNEL,ARG0,ARG1]; 85 86 $kernel->post( $counter, 'connect', $hashref ); 87} 88 89# After we successfully log into the IRC server, join a channel. 90sub irc_001 { 91 my ($kernel, $sender) = @_[KERNEL, SENDER]; 92 foreach my $counter (1..$chans) { 93 $kernel->post( $sender, 'join', '#PoCo' . $counter ); 94 } 95 undef; 96} 97 98 99sub _stop { 100 my ($kernel, $sender) = @_[KERNEL, SENDER]; 101 102 print "Control session stopped.\n"; 103# $kernel->call( $sender, 'quit', 'Neenios on ice!' ); 104 undef; 105} 106 107 108sub irc_disconnected { 109 my $server = $_[ARG0]; 110 print "Lost connection to server $server.\n"; 111 undef; 112} 113 114 115sub irc_error { 116 my $err = $_[ARG0]; 117 print "Server error occurred! $err\n"; 118 undef; 119} 120 121 122sub irc_socketerr { 123 my $err = $_[ARG0]; 124 print "Couldn't connect to server: $err\n"; 125 undef; 126} 127 128sub irc_public { 129 my ($kernel, $sender, $who, $where, $msg) = @_[KERNEL, SENDER, ARG0 .. ARG2]; 130 my $nick = (split /!/, $who)[0]; 131 #print "<$nick:@{$where}[0]> $msg\n"; 132 $kernel->post( $sender => privmsg => $where, 133 $eliza->transform($msg) # Filter it through a Chatbot. 134 ); 135 undef; 136} 137 138sub irc_join { 139 my ($kernel, $sender, $who, $where) = @_[KERNEL, SENDER, ARG0, ARG1]; 140 my $nick = (split /!/, $who)[0]; 141 $kernel->post ( $sender, 'privmsg', $where, "Hi, $nick!" ); 142 undef; 143} 144 145 146