bench.pl

#!/usr/bin/env perl
use strict;
use warnings;
use DBI;
use Parallel::ForkManager;
use Time::HiRes qw/ time sleep /;
use DBIx::Handler;
use opts;
use Digest::MD5 qw/ md5_hex /;
use Log::Minimal;
use POSIX;

sub handler;
sub warmup;
sub setup;
sub main;

opts my $setup       => "Bool",
     my $warmup      => "Bool",
     my $clients     => { isa => "Int", default => 1   },
     my $time        => { isa => "Int", default => 10  },
     my $interval    => { isa => "Num", default => 0.1 },
     my $query_cache => { isa => "Bool" },
     my $update      => { isa => "Bool" },
     my $heavy       => { isa => "Bool" },
;
my $no_update = !$update;

local $Log::Minimal::PRINT = sub {
    my ( $time, $type, $message, $trace, $raw_message) = @_;
    print "$time [$type] $message\n";
};

setup  if $setup;
warmup if $warmup;
main;

sub main {
    my $h   = handler;
    my $dbh = $h->dbh;
    $dbh->do("FLUSH STATUS");
    infof "----";
    infof "clients: %d", $clients;
    if ($no_update) {
        infof "no update";
    }
    else {
        infof "update interval: %.3f sec", $interval;
    }
    infof "query cache: %s", $query_cache ? "ON" : "OFF";
    infof "heavy query: %s", $heavy ? "ON" : "OFF";

    my $st = get_status();
    my $pm = Parallel::ForkManager->new( $clients + 1 );
    my $result = {
        queries => 0,
        elapsed => 0,
    };
    $pm->run_on_finish (
        sub {
            my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
            if ($data) {
                $result->{elapsed} += $data->[0];
                $result->{queries} += $data->[1];
            }
        }
    );
    my @pids;
 CHILD:
    for my $n ( 0 .. $clients ) {
        my $pid = $pm->start;
        if ($pid) {
            # parent
            push @pids, $pid;
            next CHILD;
        }
        my $r = $n ? run_select($n)
                   : run_update($n);
        $pm->finish( 0, $r );
    }
    sleep 1;
    my $start = time;
    debugf "child pids @pids";
    kill SIGUSR1, @pids;
    my $teardown = sub { kill SIGUSR2, @pids };
    local $SIG{INT} = $teardown;

    sleep $time;

    $teardown->();
    $pm->wait_all_children;
    my $elapsed = time - $start;

    $st = get_status($st);
    infof "query cache hit rate (%d / %d) = %.3f%%", @$st, ($st->[0] / $st->[1] * 100);

    infof "%d queries / %.3f sec = %.3f qps",
          $result->{queries},
          $result->{elapsed},
          ($result->{queries} / $elapsed),
    ;
    infof "%d,%s,%s,%s,%.3f,%.3f",
          $clients,
          ($query_cache ? "ON": "OFF"),
          ($update ? "update" : "no_update"),
          ($heavy  ? "heavy" : "light"),
          $interval,
          ($result->{queries} / $elapsed),
    ;
}

sub run_select {
    my $n = shift;
    my ($wait, $run) = (1, 1);
    debugf "spwan thread %d pid %d", $n, $$;
    local $SIG{USR1} = sub { $wait = 0 };
    local $SIG{USR2} = sub { $run = 0  };
    local $SIG{INT}  = sub {};

    sleep 1 while $wait;

    my $h = handler;
    my $start = time;
    debugf "starting select thread %d", $n;

    $h->dbh->do("SET SESSION query_cache_type = " . ($query_cache ? "ON" : "OFF"));
    my $sth_pk = $h->dbh->prepare("SELECT * FROM test WHERE id=?");
    my $sth_sk = $h->dbh->prepare("SELECT * FROM test WHERE subkey LIKE ?");
    my $sth_hv = $h->dbh->prepare("SELECT count(*) FROM test WHERE subkey LIKE ?");
    my $hex    = "0123456789abcdef";
    my $count  = 0;
    my $gen_sk = sub {
        my $n = shift;
        join( "", map { substr($hex, int rand(16), 1) } (0 .. $n - 1) ) . "%";
    };
    while ($run) {
        $h->txn_begin;
        for ( 1 .. 10 ) {
            my $rand = rand;
            if ($heavy && $rand < 0.1) {
                $sth_hv->execute( $gen_sk->(1) );
                my $r = $sth_hv->fetchrow_arrayref;
                $sth_hv->finish;
            }
            elsif ($rand < 0.5) {
                $sth_pk->execute( int rand(1_000_000) );
                my $r = $sth_pk->fetchrow_arrayref;
                $sth_pk->finish;
            }
            else {
                $sth_sk->execute( $gen_sk->(4) );
                my $r = $sth_sk->fetchall_arrayref;
                $sth_sk->finish;
            }
            ++$count;
        }
        $h->txn_commit;
    }
    my $elapsed = time - $start;
    debugf "done select thread %d: elapsed %.3f sec %d queries", $n, $elapsed, $count;
    return [ $elapsed, $count ];
}

sub run_update {
    my $n = shift;
    debugf "spwan thread %d", $n;
    if ($no_update) {
        debugf "update thread terminate";
        return [ 0, 0 ];
    }

    my ($wait, $run) = (1, 1);
    local $SIG{USR1} = sub { $wait = 0 };
    local $SIG{USR2} = sub { $run = 0  };
    local $SIG{INT}  = sub {};

    sleep 1 while $wait;

    my $h = handler;
    my $start = time;
    debugf "starting update thread %d", $n;
    my $sth = $h->dbh->prepare("UPDATE test SET content=? WHERE id=?");
    my $count  = 0;

    while ($run) {
        $h->txn_begin;
        $sth->execute( "x" x (128 + int rand(256)), int rand(1_000_000) );
        $h->txn_commit;
        sleep $interval if $interval > 0;
        $count++;
    }
    my $elapsed = time - $start;
    infof "done update thread %d: elapsed %.3f sec %d queries", $n, $elapsed, $count;
    return [ $elapsed, $count ];
}

sub handler {
    DBIx::Handler->new(
        "dbi:mysql:database=test;host=fluent01",
        "root", "",
        { RaiseError => 1, AutoCommit => 1 },
    );
}

sub warmup {
    my $h = handler;
    my $dbh = $h->dbh;
    infof "starting warmup";
    $dbh->do("DROP TABLE IF EXISTS test_bh");
    $dbh->do("CREATE TABLE test_bh ENGINE=blackhole AS SELECT * FROM test LIMIT 0");
    $dbh->do("INSERT INTO test_bh SELECT * FROM test");
    infof "warmup done";
}

sub setup {
    my $h = handler;
    my $dbh = $h->dbh;
    $dbh->do("DROP TABLE IF EXISTS test");
    $dbh->do("
        CREATE TABLE test (
          id int not null primary key auto_increment,
          subkey varchar(255) not null,
          content text,
          created_at datetime,
          updated_at timestamp
        ) ENGINE=InnoDB"
    );
    $dbh->do("CREATE INDEX test_idx ON test (subkey)");
    infof "creating table...";
    my $sth = $dbh->prepare(
        "INSERT INTO test (subkey, content, created_at) VALUES (?, ?, CURRENT_TIMESTAMP)"
    );
    for ( 1 .. 1_000_000 ) {
        $sth->execute( md5_hex(rand), "x" x (128 + int rand(256)) );
        if ($_ % 1000 == 0) {
            infof "%d rows created.", $_;
            $dbh->commit;
        }
    }
    $dbh->commit;
}

sub get_status {
    my $st = shift;
    my $handler = handler;
    my $dbh     = $handler->dbh;
    my $hit     = $dbh->selectrow_arrayref("show global status like 'Qcache_hits'")->[1];
    my $select  = $dbh->selectrow_arrayref("show global status like 'Com_select'")->[1];
    if ($st) {
        return [ $hit - $st->[0], $select - $st->[1] ];
    }
    else {
        return [ $hit, $select ];
    }
}

my.cnf

[mysqld]
datadir=/var/lib/mysql
socket=/var/lib/mysql/mysql.sock
user=mysql
# Disabling symbolic-links is recommended to prevent assorted security risks
symbolic-links=0

log-slow-queries = slow.log
long_query_time = 0.1
log-queries-not-using-indexes

innodb-buffer-pool-size=2G
innodb-log-file-size=128M
innodb-file-per-table

query-cache-size=256M

[mysqld_safe]
log-error=/var/log/mysqld.log
pid-file=/var/run/mysqld/mysqld.pid