#!/usr/bin/perl -w

use strict;
use DBI;
use Digest::MD5 qw/md5_hex/;

#------------------------------------------------------------#
# Configuration variables.                                   #
#------------------------------------------------------------#
my $tableinit = 1;
my $rows      = 2000;
my $dsn       = 'DBI:mysql:test:localhost';
my $user      = 'root';
my $pass      = '';
my $children  = 90; # Number of child processes
my $dbh_cnt   = 20; # Number of database handles per child proc.
my $infodelay = 1;  # Seconds between thread info output. (0 for none.)

my (%dbh, %name, %data);
$dbh{'master'} = DBI->connect($dsn, $user, $pass) || 
	die "Can't connect master database handle.\n";

#------------------------------------------------------------#
# Initialize our data, either by querying the existing table #
# or by creating it.                                         #
#------------------------------------------------------------#
$tableinit ? &tableinit : &datainit;

#------------------------------------------------------------#
# Fork off child procs to do random select statements.       #
#------------------------------------------------------------#
my @children;
foreach my $t (1..$children) {

	defined (my $pid = fork) || die "Can't fork!\n";		
	push (@children, $pid);
	next if $pid;

	# --- Begin child code ---

	print "Starting child $t [$$].\n";

	while (1) {
		foreach(1..$dbh_cnt) {

			# Keep trying to reconnect if needed.
			until ($dbh{$_} && $dbh{$_}->ping) {
				$dbh{$_} = DBI->connect($dsn, $user, $pass);
			}

			my $name = $name{int(rand($rows)) + 1};
			my $sth = $dbh{$_}->prepare("SELECT * FROM widgets WHERE name=$name");
			$sth->execute;
			$sth->fetchrow_hashref || print "Can't fetch: $name\n";
		}
	}

	exit 0;

	# --- end child code ---
}

#------------------------------------------------------------#
# Wait for request to quit, then kill child procs.           #
#------------------------------------------------------------#
my $killed = 0;
foreach ( qw/ INT ABRT QUIT HUP TERM STOP / ) {
	$SIG{$_} = sub { $killed = shift };
}
my $count = 0;
until ($killed) {
	if ($infodelay && $count++ eq $infodelay) {
		&threadstatus;
	} else {
		sleep 1;
	}
}
print "Caught SIG$killed... Cleaning up.\n";
kill 15, @children;

#------------------------------------------------------------#
# Creates and populates the 'widgets' table                  #
#------------------------------------------------------------#
sub tableinit {

	print "Setting up the 'widgets' table.\n";

	$dbh{'master'}->do("DROP TABLE IF EXISTS widgets;");
	$dbh{'master'}->do("
		CREATE TABLE widgets (
			id	     int(10) unsigned NOT NULL auto_increment,
			name	     varchar(255),
			data	     text,
			PRIMARY KEY  (id),
			KEY          (name),
		);
	") || die "Can't create widgets.\n";
	
	foreach(1..$rows) {
	
		$name{$_} = $dbh{'master'}->quote(md5_hex(rand(10000)));
		$data{$_} = $dbh{'master'}->quote(md5_hex(rand(10000)) x 5);
	
		$dbh{'master'}->do("
			INSERT INTO widgets (name,data)
			VALUES ($name{$_},$data{$_})
		");

	}

	print "Done with setup.\n";
}


#------------------------------------------------------------#
# Get data for our select statements.                        #
#------------------------------------------------------------#
sub datainit {
	my $sth = $dbh{'master'}->prepare("SELECT * FROM widgets");
	$sth->execute;

	while (my $row = $sth->fetchrow_hashref) {
		$name{$row->{'id'}} = $dbh{'master'}->quote($row->{'name'});
		$data{$row->{'id'}} = $dbh{'master'}->quote($row->{'data'});
	}
}

#------------------------------------------------------------#
# Get the thread status from the master dbh.                 #
#------------------------------------------------------------#
sub threadstatus {
	my %vars;
	$count = 0;
	my $sth = $dbh{'master'}->prepare("SHOW STATUS LIKE 'threads_%'");
	$sth->execute;
	while(my $row = $sth->fetchrow_hashref) {
		$vars{$row->{'Variable_name'}} = $row->{'Value'};
	}

	print "Threads (connected/running/created/cached): ",
		$vars{'Threads_connected'}, "/",
		$vars{'Threads_running'}, "/",
		$vars{'Threads_created'}, "/",
		$vars{'Threads_cached'}, "\n";
}