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