MySQL database monitor

Here is a tool published a few years ago that I've recently tweaked. I don't know how people could live without something like this.

#!/usr/bin/perl -w

#
# Copyright 2003-2008 Dale Johnson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .
# 
use strict;
use DBI;
use Time::HiRes qw/gettimeofday usleep/;
use POSIX qw/setsid/;
use Digest::MD5 qw/md5_hex/;

my $signalled = 0;

$SIG{ INT } = $SIG{ TERM } = sub {
        print "signalled...\n";
        $signalled++;
};

my $start_time = time();
my $total_seconds_to_run = shift || 0;
my $stop_time = $start_time + $total_seconds_to_run;

my $dbuser = "****"; 
my $dbpass = "****"; 
my $hostname = "localhost";

my $interval = 10 * 1000;  # 40 ms
my $daemon = 0;

my $dbh;
my $sth;

sub db_connect {
        eval {
                $dbh = DBI->connect("dbi:mysql:hostname=$hostname", $dbuser, $dbpass,
                        {RaiseError => 1});
                print STDERR $dbh->errstr . "\n" if defined $dbh->errstr;
        };
        if( $@ ) {
                die "error $@";
        }
}

sub normalize {
        my $query = shift;
        $query =~ s/'[^']*'/?/g;
        $query =~ s/NULL/?/g;
        $query =~ s/\d+/?/g;
        $query =~ s/\t/ /g;
        $query =~ s/\n/ /g;
        $query =~ s/\s+/ /g;
        $query =~ s/-\?/\?/g;
        return $query;
}

my $normalized_time;
my $normalized_count;
#chomp;@a=split(/\t/);$a[0]=~s/\d+/?/g; $a[0]=~s/'\''[^'\'']*'\''/?/g; $a[0]=~s/NULL/?/g; print join("
#\t",@a)."\n";' | sort | pmrollup 1 2 ':0,[,@0,]sum,[,@1,]sum' | pmscan :1,:2,:0 | sort -n -r -k2 | less -S
#}

my %queries;
my %states;
my %users;
my %hosts;
my %ids;
my $queryid = 1;
$|=1;
my $prevtm = 0;
my $dumpat = time() + 3600;
db_connect();
while( 1 ) {
    eval {
        my @this_dbid = ();
        $sth = $dbh->prepare("show full processlist");
        $sth->execute();
        while (my @row = $sth->fetchrow()) {
            my $tm = scalar localtime time();
            my ($dbid, $user, $host, $dbname, $state, $time, $action, $query) = map { defined $_ ? $_ : "undef" } @row;
            undef @row;
            next if ($state eq "Sleep");
            next if ($query eq "undef");
            next if ($query eq "show full processlist");
                        next if ($user eq "system user");
            my $digest = substr(md5_hex($query),0,12);
            $query =~ s/\t/ /g;
            $query =~ s/\n/ /g;
            $query =~ s/\r/ /g;
            push @this_dbid, $query;
            if (not exists $queries{$query}) {
                $queries{$query} = gettimeofday();
                $states{$query}  = $state;
                $users{$query}   = $user;
                $ids{$query}     = $queryid++;
                $hosts{$query}   = $host;
            }
            if ($state ne $states{$query}) {
                $states{$query} = $state;
            }
            $prevtm = $tm;
        }
        for my $qid (keys %queries) {
            my $digest = substr(md5_hex($qid),0,12);
            my $tm = time();
            my $user = $users{$qid};
            my $state = $states{$qid};
            my $host = $hosts{$qid};
            if( ! scalar grep ( { $qid eq $_ } @this_dbid)) {
                # this is a done query i hope
                $normalized_time->{ normalize( $qid ) } +=
                                                gettimeofday() - $queries{$qid};
                $normalized_count->{ normalize( $qid ) }++;

                delete $states{$qid};
                delete $users{$qid};
                delete $hosts{$qid};
                delete $ids{$qid};
                delete $queries{$qid};
            }
        }
    };
    if( $@ ) {
        print STDERR "reconnecting to localhost ($@)\n";
        sleep 10;
        db_connect();
    }
    usleep $interval;
    if( $dumpat < time() ) {
        print STDERR "STATE DUMP\n";
        print STDERR "queries sz: " . (scalar (keys %queries)) . "\n";
        print STDERR "states  sz: " . (scalar (keys %states)) . "\n";
        print STDERR "users   sz: " . (scalar (keys %users)) . "\n";
        print STDERR "ids     sz: " . (scalar (keys %ids)) . "\n";
        $dumpat = time() + 3600;
    }
    last if $total_seconds_to_run > 0 && time() > $stop_time;
    last if $signalled;
}
print "\ncount\telapsed\taverage\tquery\n";
print   "=====\t=======\t=======\t=====\n";
for my $q ( sort { $normalized_time->{ $b } <=> $normalized_time->{ $a } }
                keys %$normalized_time ) {
    printf "%d\t%3.1f s\t%2.0f ms\t%s\n",
                $normalized_count->{ $q }, $normalized_time->{ $q },
                ( $normalized_time->{ $q } / $normalized_count->{ $q } ) * 1000,
                $q;
}

It locates the queries that are hogging time on your system. Output looks like this:

signalled...

count   elapsed average query
=====   ======= ======= =====
1       0.0 s   11 ms   insert into vcontact (id_user_ident_table_posessor, id_user_ident_table_actual, first_name, last_name, email, create_datetime, modify_datetime, extra, extra_big, comments, permission) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
1       0.0 s   11 ms   INSERT INTO user_friends_count (id_user_ident_table, friends_count) SELECT NEW.id_user_ident_table_posessor,? ON DUPLICATE KEY UPDATE friends_count = friends_count + ?