The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use blib;
use lib 't/lib';
use GTop;
use Time::HiRes qw(time);

require 'djabberd-test.pl';

my $server = Test::DJabberd::Server->new( id => 1 );
$server->start;

my $pid = fork;

unless (defined $pid) {
    die "Fork failed\n";
}

if ($pid) {
    while (1) {
	my $gtop = GTop->new;
	my $proc_mem = $gtop->proc_mem( $server->{pid} );
	printf( "Flags:%s Size:%s VSize:%s Resident:%s Share:%s RSS:%s RSSLimit:%s\n",
		$proc_mem->flags,
		$proc_mem->size,
		$proc_mem->vsize,
		$proc_mem->resident,
		$proc_mem->share,
		$proc_mem->rss,
		$proc_mem->rss_rlim,
		);
	sleep 1;
    }
}

fork; fork; fork; fork;

my @clients;

warn "[$$] Connecting 25 clients";

while (@clients < 25) {
    my $client = Test::DJabberd::Client->new(server => $server, name => gen_client_id() );
    $client->login;
    push @clients, $client;
}

warn "[$$] Sending presence";

foreach my $client (@clients) {
    $client->send_xml("<presence/>");
}

warn "[$$] Passing messages";

my $prevclient = $clients[0];
my $prevtime = time;
while (1) {
    my $timediff = time - $prevtime;
    my $numclients = scalar @clients;

    warn "[$$] Time for " . $numclients . " clients: " . $timediff . " (" . $numclients / $timediff . "/sec)";

    $prevtime = time;

    foreach my $client (@clients) {
	$prevclient->send_xml( qq(<message type="chat" to="$client">Hello you</message>) );
	my $output = $client->recv_xml;
	$prevclient = $client;
    }
}

END {
    $server->kill;
}

{
    my $counter = 0;
    sub gen_client_id {
	return "client_${$}_" . $counter++;
    }
}