#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# vim: foldmethod=marker:tw=160:nowrap:expandtab:tabstop=3:shiftwidth=3:softtabstop=3
# vim users, set modeline to enable auto-folding and compatibility with my preferred
# formatting.  I use a very wide textwidth because there's tons of configuration
# data that's much easier to manage when it's laid out in a (wide) tabular
# format.  I try to keep most real code to a textwidth of 80 or so.

use strict;
use warnings FATAL => 'all';
use sigtrap qw(handler finish untrapped normal-signals);

use Data::Dumper;
use DBI;
use English qw(-no_match_vars);
use Getopt::Long;
use List::Util qw(max min maxstr);
use InnoDBParser;

# Version, license and warranty information. {{{1
# ###########################################################################
our $VERSION = '1.4.0';

my $innotop_license = <<"LICENSE";

This is innotop version $VERSION, a MySQL and InnoDB monitor.

This program is copyright (c) 2006 Baron Schwartz, baron at xaprb dot com.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

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, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.
LICENSE

# Configuration information and global setup {{{1
# ###########################################################################

# Really, really, super-global variables.
my @config_versions = (
   "000-000-000", "001-003-000", # config file was one big name-value hash.
);

my $clear_screen_sub;

# This defines expected properties and defaults for the column definitions that
# eventually end up in tbl_meta.
my %col_props = (
   hdr   => '',
   just  => '-',
   num   => 0,
   label => '',
   user  => 0,
   src   => '',
   tbl   => '', # Helps when writing/reading custom columns in config files
   expr  => '', # In case column's src is an expression, the name of the expr
   minw  => 0,
   maxw  => 0,
   trans => [],
);

# I use my own caching because I need to explicitly know when I actually get a new
# connection.  It's just easier to code it myself.
my %dbhs;

# Command-line parameters {{{2
# ###########################################################################

# Define cmdline args; each is spec, config, desc.  Add more hash entries as needed.
my %opt_spec = (
   h => { s => 'help|h',                       d => 'Show this help message' },
   c => { s => 'config|c=s',                   d => 'Config file to read' },
   n => { s => 'nonint|n',                     d => 'Non-interactive, output tab-separated fields' },
   m => { s => 'mode|m=s',   config => 'mode', d => 'Operating mode to start in' },
);

# Define the order cmdline opts will appear in help output.  Add any extra ones
# defined above.
my @opt_keys = qw( c n m h );

# This is the container for the command-line options' values to be stored in
# after processing.  Initial values are defaults.
my %opts = (
   n => !( -t STDIN && -t STDOUT ), # If in/out aren't to terminals, we're interactive
);

Getopt::Long::Configure('no_ignore_case', 'bundling');
GetOptions( map { $opt_spec{$_}->{'s'} => \$opts{$_} }  @opt_keys );

if ( $opts{'h'} ) {
   print "Usage: innotop <options>\n\nOptions:\n\n";
   foreach my $key ( @opt_keys ) {
      my ( $long, $short ) = $opt_spec{$key}->{'s'} =~ m/^(\w+)(?:\|([^=]*))?/;
      $long  = "--$long" . ( $short ? ',' : '' );
      $short = $short ? " -$short" : '';
      printf("  %-13s %-4s %s\n", $long, $short, $opt_spec{$key}->{'d'});
   }
   print <<USAGE;

innotop connects to a MySQL database and displays information from it so you can
monitor its status, such as what queries are running.

USAGE
   exit(1);
}

# Meta-data (table definitions etc) {{{2
# ###########################################################################

# Expressions {{{3
# Each expression looks like this when fully hydrated:
# Name => { func => sub{ return 1 }, text => 'return 1', user => 1 }
#   * The text is the plain text of the expression
#   * The func is that text, compiled into a subroutine
#   * The user is whether it's user-defined, and hence needs writing to config
# So the loading is exactly the same whether user-defined or built-in, the
# expressions aren't initially stored here; they are initially stored in a
# hash that looks just like what comes out of the config file.  Those are
# hydrated with the compile_expr() function.
# ###########################################################################
my %exprs         = ();
my %builtin_exprs = (
   # TODO remove more of these.
   Host              => q{my $host = $set->{Host} || $set->{hostname} || ''; ($host) = $host =~ m/^((?:[\d.]+(?=:))|(?:[a-zA-Z]\w+))/; return $host || ''},
   HostAndDomain     => q{my $host = $set->{Host} || $set->{hostname} || ''; ($host) = $host =~ m/^([^:]+)/; return $host || ''},
   Port              => q{my ( $port ) = $set->{Host} =~ m/:(.*)$/; return $port || 0},
   QPS               => q{$set->{Uptime_hires} ? $set->{Questions} / ($set->{Uptime_hires} || 1) : 0},
   ReplByteLag       => q{defined $set->{Master_Log_File} && $set->{Master_Log_File} eq $set->{Relay_Master_Log_File} ? $set->{Read_Master_Log_Pos} - $set->{Exec_Master_Log_Pos} : 0},
   OldVersions       => q{dulint_to_int($set->{IB_tx_trx_id_counter}) - dulint_to_int($set->{IB_tx_purge_done_for})},
   MaxTxnTime        => q{max(map{ $_->{active_secs} } @{$set->{IB_tx_transactions}}) || 0},
   NumTxns           => q{scalar @{$set->{IB_tx_transactions}} },
   DirtyBufs         => q{ $set->{IB_bp_pages_modified} / ($set->{IB_bp_buf_pool_size} || 1) },
   BufPoolFill       => q{ $set->{IB_bp_pages_total} / ($set->{IB_bp_buf_pool_size} || 1) },
);
foreach my $key ( keys %builtin_exprs ) {
   my ( $sub, $err ) = compile_expr($builtin_exprs{$key});
   $exprs{$key} = {
      func => $sub,
      text => $builtin_exprs{$key},
      user => 0,
      name => $key, # useful for later
   }
}

# ###########################################################################
# Column definitions {{{3
# Defines every column in every table. A named column has the following
# properties:
#    * hdr    Column header/title
#    * label  Documentation for humans.
#    * num    Whether it's numeric (for sorting).
#    * just   Alignment; generated from num, user-overridable in tbl_meta
#    * minw, maxw Auto-generated, user-overridable.
# Values from this hash are just copied to tbl_meta, which is where everything
# else in the program should read from.
# ###########################################################################

my %columns = (
   active_secs                 => { hdr => 'SecsActive',          num => 1, label => 'Seconds transaction has been active', },
   add_pool_alloc              => { hdr => 'Add\'l Pool',         num => 1, label => 'Additonal pool allocated' },
   attempted_op                => { hdr => 'Action',              num => 0, label => 'The action that caused the error' },
   awe_mem_alloc               => { hdr => 'AWE Memory',          num => 1, label => '[Windows] AWE memory allocated' },
   binlog_do_db                => { hdr => 'Binlog Do DB',        num => 0, label => 'binlog-do-db setting' },
   binlog_ignore_db            => { hdr => 'Binlog Ignore DB',    num => 0, label => 'binlog-ignore-db setting' },
   bps_in                      => { hdr => 'BpsIn',               num => 1, label => 'Bytes per second received by the server', },
   bps_out                     => { hdr => 'BpsOut',              num => 1, label => 'Bytes per second sent by the server', },
   buf_free                    => { hdr => 'Free Bufs',           num => 1, label => 'Buffers free in the buffer pool' },
   buf_pool_hit_rate           => { hdr => 'Hit Rate',            num => 0, label => 'Buffer pool hit rate' },
   buf_pool_hits               => { hdr => 'Hits',                num => 1, label => 'Buffer pool hits' },
   buf_pool_reads              => { hdr => 'Reads',               num => 1, label => 'Buffer pool reads' },
   buf_pool_size               => { hdr => 'Size',                num => 1, label => 'Buffer pool size' },
   bufs_in_node_heap           => { hdr => 'Node Heap Bufs',      num => 1, label => 'Buffers in buffer pool node heap' },
   bytes_behind_master         => { hdr => 'ByteLag',             num => 1, label => 'Bytes the slave lags the master in binlog' },
   cell_event_set              => { hdr => 'Ending?',             num => 1, label => 'Whether the cell event is set' },
   cell_waiting                => { hdr => 'Waiting?',            num => 1, label => 'Whether the cell is waiting' },
   child_db                    => { hdr => 'Child DB',            num => 0, label => 'The database of the child table' },
   child_index                 => { hdr => 'Child Index',         num => 0, label => 'The index in the child table' },
   child_table                 => { hdr => 'Child Table',         num => 0, label => 'The child table' },
   cmd                         => { hdr => 'Cmd',                 num => 0, label => 'Type of command being executed', },
   connect_retry               => { hdr => 'Connect Retry',       num => 1, label => 'Slave connect-retry timeout' },
   cxn                         => { hdr => 'CXN',                 num => 0, label => 'Connection from which the data came', },
   db                          => { hdr => 'DB',                  num => 0, label => 'Current database', },
   dl_txn_num                  => { hdr => 'Num',                 num => 0, label => 'Deadlocked transaction number', },
   event_set                   => { hdr => 'Evt Set?',            num => 1, label => '[Win32] if a wait event is set', },
   exec_master_log_pos         => { hdr => 'Exec Master Log Pos', num => 1, label => 'Exec Master Log Position' },
   fk_name                     => { hdr => 'Constraint',          num => 0, label => 'The name of the FK constraint' },
   free_list_len               => { hdr => 'Free List Len',       num => 1, label => 'Length of the free list' },
   has_read_view               => { hdr => 'Rd View',             num => 1, label => 'Whether the transaction has a read view' },
   hash_searches_s             => { hdr => 'Hash/Sec',            num => 1, label => 'Number of hash searches/sec' },
   hash_table_size             => { hdr => 'Size',                num => 1, label => 'Number of non-hash searches/sec' },
   heap_no                     => { hdr => 'Heap',                num => 1, label => 'Heap number' },
   heap_size                   => { hdr => 'Heap',                num => 1, label => 'Heap size' },
   host_and_domain             => { hdr => 'Host',                num => 0, label => 'Hostname/IP and domain' },
   host_and_port               => { hdr => 'Host/IP',             num => 0, label => 'Hostname or IP address, and port number', },
   host_or_ip                  => { hdr => 'Host',                num => 0, label => 'Hostname or IP address', },
   hostname                    => { hdr => 'Host',                num => 0, label => 'Hostname' },
   index                       => { hdr => 'Index',               num => 0, label => 'The index involved' },
   index_ref                   => { hdr => 'Index Ref',           num => 0, label => 'Index referenced' },
   info                        => { hdr => 'Query',               num => 0, label => 'Info or the current query', },
   insert_intention            => { hdr => 'Ins Intent',          num => 1, label => 'Whether the thread was trying to insert' },
   inserts                     => { hdr => 'Inserts',             num => 1, label => 'Inserts' },
   io_bytes_s                  => { hdr => 'Bytes/Sec',           num => 1, label => 'Average I/O bytes/sec' },
   io_flush_type               => { hdr => 'Flush Type',          num => 0, label => 'I/O Flush Type' },
   io_fsyncs_s                 => { hdr => 'fsyncs/sec',          num => 1, label => 'I/O fsyncs/sec' },
   io_reads_s                  => { hdr => 'Reads/Sec',           num => 1, label => 'Average I/O reads/sec' },
   io_writes_s                 => { hdr => 'Writes/Sec',          num => 1, label => 'Average I/O writes/sec' },
   ip                          => { hdr => 'IP',                  num => 0, label => 'IP address' },
   is_name_locked              => { hdr => 'Locked',              num => 1, label => 'Whether table is name locked', },
   key_buffer_hit              => { hdr => 'KCacheHit',           num => 1, label => 'Key cache hit ratio', },
   key_len                     => { hdr => 'Key Length',          num => 1, label => 'Number of bytes used in the key' },
   last_chkp                   => { hdr => 'Last Checkpoint',     num => 0, label => 'Last log checkpoint' },
   last_errno                  => { hdr => 'Last Errno',          num => 1, label => 'Last error number' },
   last_error                  => { hdr => 'Last Error',          num => 0, label => 'Last error' },
   last_s_file_name            => { hdr => 'S-File',              num => 0, label => 'Filename where last read locked' },
   last_s_line                 => { hdr => 'S-Line',              num => 1, label => 'Line where last read locked' },
   last_x_file_name            => { hdr => 'X-File',              num => 0, label => 'Filename where last write locked' },
   last_x_line                 => { hdr => 'X-Line',              num => 1, label => 'Line where last write locked' },
   lock_cfile_name             => { hdr => 'Crtd File',           num => 0, label => 'Filename where lock created' },
   lock_cline                  => { hdr => 'Crtd Line',           num => 1, label => 'Line where lock created' },
   lock_mem_addr               => { hdr => 'Addr',                num => 0, label => 'The lock memory address' },
   lock_mode                   => { hdr => 'Mode',                num => 0, label => 'The lock mode' },
   lock_structs                => { hdr => 'LStrcts',             num => 1, label => 'Number of lock structs' },
   lock_type                   => { hdr => 'Type',                num => 0, label => 'The lock type' },
   lock_var                    => { hdr => 'Lck Var',             num => 1, label => 'The lock variable' },
   lock_wait_time              => { hdr => 'Wait',                num => 1, label => 'How long txn has waited for a lock' },
   log_flushed_to              => { hdr => 'Flushed To',          num => 0, label => 'Log position flushed to' },
   log_ios_done                => { hdr => 'IO Done',             num => 1, label => 'Log I/Os done' },
   log_ios_s                   => { hdr => 'IO/Sec',              num => 1, label => 'Average log I/Os per sec' },
   log_seq_no                  => { hdr => 'Sequence No.',        num => 0, label => 'Log sequence number' },
   main_thread_id              => { hdr => 'Main Thread ID',      num => 1, label => 'Main thread ID' },
   main_thread_proc_no         => { hdr => 'Main Thread Proc',    num => 1, label => 'Main thread process number' },
   main_thread_state           => { hdr => 'Main Thread State',   num => 0, label => 'Main thread state' },
   master_file                 => { hdr => 'File',                num => 0, label => 'Master file' },
   master_host                 => { hdr => 'Master',              num => 0, label => 'Master server hostname' },
   master_log_file             => { hdr => 'Master Log File',     num => 0, label => 'Master log file' },
   master_port                 => { hdr => 'Master Port',         num => 1, label => 'Master port' },
   master_pos                  => { hdr => 'Position',            num => 1, label => 'Master position' },
   master_ssl_allowed          => { hdr => 'Master SSL Allowed',  num => 0, label => 'Master SSL Allowed' },
   master_ssl_ca_file          => { hdr => 'Master SSL CA File',  num => 0, label => 'Master SSL Cert Auth File' },
   master_ssl_ca_path          => { hdr => 'Master SSL CA Path',  num => 0, label => 'Master SSL Cert Auth Path' },
   master_ssl_cert             => { hdr => 'Master SSL Cert',     num => 0, label => 'Master SSL Cert' },
   master_ssl_cipher           => { hdr => 'Master SSL Cipher',   num => 0, label => 'Master SSL Cipher' },
   master_ssl_key              => { hdr => 'Master SSL Key',      num => 0, label => 'Master SSL Key' },
   master_user                 => { hdr => 'Master User',         num => 0, label => 'Master username' },
   merged_recs                 => { hdr => 'Merged Recs',         num => 1, label => 'Merged records' },
   merges                      => { hdr => 'Merges',              num => 1, label => 'Merges' },
   mutex_os_waits              => { hdr => 'Waits',               num => 1, label => 'Mutex OS Waits' },
   mutex_spin_rounds           => { hdr => 'Rounds',              num => 1, label => 'Mutex Spin Rounds' },
   mutex_spin_waits            => { hdr => 'Spins',               num => 1, label => 'Mutex Spin Waits' },
   mysql_thread_id             => { hdr => 'ID',                  num => 1, label => 'MySQL connection (thread) ID', },
   n_bits                      => { hdr => '# Bits',              num => 1, label => 'Number of bits' },
   non_hash_searches_s         => { hdr => 'Non-Hash/Sec',        num => 1, label => 'Non-hash searches/sec' },
   num_deletes                 => { hdr => 'Del',                 num => 1, label => 'Number of deletes' },
   num_deletes_sec             => { hdr => 'Del/Sec',             num => 1, label => 'Number of deletes' },
   num_inserts                 => { hdr => 'Ins',                 num => 1, label => 'Number of inserts' },
   num_inserts_sec             => { hdr => 'Ins/Sec',             num => 1, label => 'Number of inserts' },
   num_locks                   => { hdr => 'Num Lcks',            num => 1, label => 'Number of locks' },
   num_readers                 => { hdr => 'Readers',             num => 1, label => 'Number of readers' },
   num_reads                   => { hdr => 'Read',                num => 1, label => 'Number of reads' },
   num_reads_sec               => { hdr => 'Read/Sec',            num => 1, label => 'Number of reads' },
   num_res_ext                 => { hdr => 'BTree Extents',       num => 1, label => 'Number of extents reserved for B-Tree' },
   num_rows                    => { hdr => 'Row Count',           num => 1, label => 'Number of rows estimated to examine' },
   num_times_open              => { hdr => 'In Use',              num => 1, label => '# times table is opened', },
   num_updates                 => { hdr => 'Upd',                 num => 1, label => 'Number of updates' },
   num_updates_sec             => { hdr => 'Upd/Sec',             num => 1, label => 'Number of updates' },
   os_file_reads               => { hdr => 'OS Reads',            num => 1, label => 'OS file reads' },
   os_file_writes              => { hdr => 'OS Writes',           num => 1, label => 'OS file writes' },
   os_fsyncs                   => { hdr => 'OS fsyncs',           num => 1, label => 'OS fsyncs' },
   os_thread_id                => { hdr => 'OS Thread',           num => 1, label => 'The operating system thread ID' },
   p_aio_writes                => { hdr => 'Async Wrt',           num => 1, label => 'Pending asynchronous I/O writes' },
   p_buf_pool_flushes          => { hdr => 'Buffer Pool Flushes', num => 1, label => 'Pending buffer pool flushes' },
   p_ibuf_aio_reads            => { hdr => 'IBuf Async Rds',      num => 1, label => 'Pending insert buffer asynch I/O reads' },
   p_log_flushes               => { hdr => 'Log Flushes',         num => 1, label => 'Pending log flushes' },
   p_log_ios                   => { hdr => 'Log I/Os',            num => 1, label => 'Pending log I/O operations' },
   p_normal_aio_reads          => { hdr => 'Async Rds',           num => 1, label => 'Pending asynchronous I/O reads' },
   p_preads                    => { hdr => 'preads',              num => 1, label => 'Pending p-reads' },
   p_pwrites                   => { hdr => 'pwrites',             num => 1, label => 'Pending p-writes' },
   p_sync_ios                  => { hdr => 'Sync I/Os',           num => 1, label => 'Pending synchronous I/O operations' },
   page_creates_sec            => { hdr => 'Creates/Sec',         num => 1, label => 'Page creates/sec' },
   page_no                     => { hdr => 'Page',                num => 1, label => 'Page number' },
   page_reads_sec              => { hdr => 'Reads/Sec',           num => 1, label => 'Page reads per second' },
   page_writes_sec             => { hdr => 'Writes/Sec',          num => 1, label => 'Page writes per second' },
   pages_created               => { hdr => 'Created',             num => 1, label => 'Pages created' },
   pages_modified              => { hdr => 'Dirty Pages',         num => 1, label => 'Pages modified (dirty)' },
   pages_read                  => { hdr => 'Reads',               num => 1, label => 'Pages read' },
   pages_total                 => { hdr => 'Pages',               num => 1, label => 'Pages total' },
   pages_written               => { hdr => 'Writes',              num => 1, label => 'Pages written' },
   parent_col                  => { hdr => 'Parent Column',       num => 0, label => 'The referred column in the parent table', },
   parent_db                   => { hdr => 'Parent DB',           num => 0, label => 'The database of the parent table' },
   parent_index                => { hdr => 'Parent Index',        num => 0, label => 'The referred index in the parent table' },
   parent_table                => { hdr => 'Parent Table',        num => 0, label => 'The parent table' },
   part_id                     => { hdr => 'Part ID',             num => 1, label => 'Sub-part ID of the query' },
   partitions                  => { hdr => 'Partitions',          num => 0, label => 'Query partitions used' },
   pending_chkp_writes         => { hdr => 'Chkpt Writes',        num => 1, label => 'Pending log checkpoint writes' },
   pending_log_writes          => { hdr => 'Log Writes',          num => 1, label => 'Pending log writes' },
   port                        => { hdr => 'Port',                num => 1, label => 'Client port number', },
   possible_keys               => { hdr => 'Poss. Keys',          num => 0, label => 'Possible keys' },
   proc_no                     => { hdr => 'Proc',                num => 1, label => 'Process number' },
   q_cache_hit                 => { hdr => 'QCacheHit',           num => 1, label => 'Query cache hit ratio', },
   qps                         => { hdr => 'QPS',                 num => 1, label => 'How many queries/sec', },
   queries_in_queue            => { hdr => 'Queries Queued',      num => 1, label => 'Queries in queue' },
   queries_inside              => { hdr => 'Queries Inside',      num => 1, label => 'Queries inside InnoDB' },
   query_id                    => { hdr => 'Query ID',            num => 1, label => 'Query ID' },
   query_status                => { hdr => 'Query Status',        num => 0, label => 'The query status' },
   query_text                  => { hdr => 'Query Text',          num => 0, label => 'The query text' },
   questions                   => { hdr => 'Questions',           num => 1, label => 'How many queries the server has gotten', },
   read_master_log_pos         => { hdr => 'Read Master Pos',     num => 1, label => 'Read master log position' },
   read_views_open             => { hdr => 'Rd Views',            num => 1, label => 'Number of read views open' },
   reads_pending               => { hdr => 'Pending Reads',       num => 1, label => 'Reads pending' },
   relay_log_file              => { hdr => 'Relay File',          num => 0, label => 'Relay log file' },
   relay_log_pos               => { hdr => 'Relay Pos',           num => 1, label => 'Relay log position' },
   relay_log_size              => { hdr => 'Relay Size',          num => 1, label => 'Relay log size' },
   relay_master_log_file       => { hdr => 'Relay Master File',   num => 0, label => 'Relay master log file' },
   replicate_do_db             => { hdr => 'Do DB',               num => 0, label => 'Replicate-do-db setting' },
   replicate_do_table          => { hdr => 'Do Table',            num => 0, label => 'Replicate-do-table setting' },
   replicate_ignore_db         => { hdr => 'Ignore DB',           num => 0, label => 'Replicate-ignore-db setting' },
   replicate_ignore_table      => { hdr => 'Ignore Table',        num => 0, label => 'Replicate-do-table setting' },
   replicate_wild_do_table     => { hdr => 'Wild Do Table',       num => 0, label => 'Replicate-wild-do-table setting' },
   replicate_wild_ignore_table => { hdr => 'Wild Ignore Table',   num => 0, label => 'Replicate-wild-ignore-table setting' },
   request_type                => { hdr => 'Type',                num => 0, label => 'Type of lock the thread waits for' },
   reservation_count           => { hdr => 'ResCnt',              num => 1, label => 'Reservation Count' },
   row_header                  => { hdr => 'What',                num => 0, label => 'Row header' },
   rw_excl_os_waits            => { hdr => 'RW Waits',            num => 1, label => 'R/W Excl. OS Waits' },
   rw_excl_spins               => { hdr => 'RW Spins',            num => 1, label => 'R/W Excl. Spins' },
   rw_shared_os_waits          => { hdr => 'Sh Waits',            num => 1, label => 'R/W Shared OS Waits' },
   rw_shared_spins             => { hdr => 'Sh Spins',            num => 1, label => 'R/W Shared Spins' },
   scan_type                   => { hdr => 'Type',                num => 0, label => 'Scan type in chosen' },
   seg_size                    => { hdr => 'Seg. Size',           num => 1, label => 'Segment size' },
   select_type                 => { hdr => 'Select Type',         num => 0, label => 'Type of select used' },
   signal_count                => { hdr => 'Signals',             num => 1, label => 'Signal Count' },
   size                        => { hdr => 'Size',                num => 1, label => 'Size of the tablespace' },
   skip_counter                => { hdr => 'Skip Counter',        num => 1, label => 'Skip counter' },
   slave_io_running            => { hdr => 'Slave-IO',            num => 0, label => 'Whether the slave I/O thread is running' },
   slave_io_state              => { hdr => 'Slave IO State',      num => 0, label => 'Slave I/O thread state' },
   slave_open_temp_tables      => { hdr => 'Temp',                num => 1, label => 'Slave open temp tables' },
   slave_sql_running           => { hdr => 'Slave-SQL',           num => 0, label => 'Whether the slave SQL thread is running' },
   slow                        => { hdr => 'Slow',                num => 1, label => 'How many slow queries', },
   space_id                    => { hdr => 'Space',               num => 1, label => 'Tablespace ID' },
   special                     => { hdr => 'Special',             num => 0, label => 'Special/Other info' },
   state                       => { hdr => 'State',               num => 0, label => 'Connection state', },
   tables_in_use               => { hdr => 'Tbl Used',            num => 1, label => 'Number of tables in use' },
   tables_locked               => { hdr => 'Tbl Lck',             num => 1, label => 'Number of tables locked' },
   tbl                         => { hdr => 'Table',               num => 0, label => 'Table', },
   thread                      => { hdr => 'Thread',              num => 1, label => 'Thread number' },
   thread_decl_inside          => { hdr => 'Thread Inside',       num => 0, label => 'What the thread is declared inside' },
   thread_purpose              => { hdr => 'Purpose',             num => 0, label => "The thread's purpose" },
   thread_status               => { hdr => 'Thread Status',       num => 0, label => 'The thread status' },
   time                        => { hdr => 'Time',                num => 1, label => 'Time since the last event', },
   time_behind_master          => { hdr => 'TimeLag',             num => 1, label => 'Time slave lags master' },
   timestring                  => { hdr => 'Timestring',          num => 0, label => 'Time the event occurred' },
   total_mem_alloc             => { hdr => 'Memory',              num => 1, label => 'Total memory allocated' },
   truncates                   => { hdr => 'Trunc',               num => 0, label => 'Whether the deadlock is truncating InnoDB status' },
   txn_doesnt_see_ge           => { hdr => "Txn Won't See",       num => 0, label => 'Where txn read view is limited' },
   txn_id                      => { hdr => 'ID',                  num => 0, label => 'Transaction ID' },
   txn_sees_lt                 => { hdr => 'Txn Sees',            num => 1, label => 'Where txn read view is limited' },
   txn_status                  => { hdr => 'Txn Status',          num => 0, label => 'Transaction status' },
   undo_log_entries            => { hdr => 'Undo',                num => 1, label => 'Number of undo log entries' },
   until_condition             => { hdr => 'Until Condition',     num => 0, label => 'Slave until condition' },
   until_log_file              => { hdr => 'Until Log File',      num => 0, label => 'Slave until log file' },
   until_log_pos               => { hdr => 'Until Log Pos',       num => 1, label => 'Slave until log position' },
   used_cells                  => { hdr => 'Cells Used',          num => 1, label => 'Number of cells used' },
   user                        => { hdr => 'User',                num => 0, label => 'Database username', },
   victim                      => { hdr => 'Victim',              num => 0, label => 'Whether this txn was the deadlock victim' },
   wait_array_size             => { hdr => 'Wait Array Size',     num => 1, label => 'Wait Array Size' },
   wait_status                 => { hdr => 'Lock Wait?',          num => 0, label => 'Whether txn is waiting for a lock' },
   waited_at_filename          => { hdr => 'File',                num => 0, label => 'Filename at which thread waits' },
   waited_at_line              => { hdr => 'Line',                num => 1, label => 'Line at which thread waits' },
   waiters_flag                => { hdr => 'Waiters',             num => 1, label => 'Waiters Flag' },
   waiting                     => { hdr => 'Wait',                num => 1, label => 'Whether txn is waiting for a lock' },
   when                        => { hdr => 'When',                num => 0, label => 'Time scale' },
   writer_lock_mode            => { hdr => 'Wrtr Lck Mode',       num => 0, label => 'Writer lock mode' },
   writer_thread               => { hdr => 'Wrtr Thread',         num => 1, label => 'Writer thread ID' },
   writes_pending              => { hdr => 'Writes',              num => 1, label => 'Number of writes pending' },
   writes_pending_flush_list   => { hdr => 'Flush List Writes',   num => 1, label => 'Number of flush list writes pending' },
   writes_pending_lru          => { hdr => 'LRU Writes',          num => 1, label => 'Number of LRU writes pending' },
   writes_pending_single_page  => { hdr => '1-Page Writes',       num => 1, label => 'Number of 1-page writes pending' },
);

# Apply a default property or three.  By default, columns are not width-constrained,
# aligned left, and sorted alphabetically, not numerically.
foreach my $col ( values %columns ) {
   map { $col->{$_} ||= 0 } qw(num minw maxw);
   $col->{just} = $col->{num} ? '' : '-';
}

# Filters {{{3
# This hash defines every filter that can be applied to a table.  These
# become part of tbl_meta as well.  Each filter is just an expression that
# returns true or false, just like values in %exprs.
# Properties of each entry:
#  * func:   the subroutine
#  * name:   the name, repeated
#  * user:   whether it's a user-defined filter (saved in config)
#  * text:   text of the subroutine
#  * note:   explanation
my %filters = ();

# These are pre-processed to live in %filters above, by compiling them.
my %builtin_filters = (
   hide_self => {
      text => <<'      END',
         return ( !$set->{info} || $set->{info} ne 'SHOW FULL PROCESSLIST' )
             && ( !$set->{query_text}    || $set->{query_text} !~ m/INNODB STATUS$/ );
      END
      note => 'Removes the innotop processes from the list',
      tbls => [qw(innodb_transactions processlist)],
   },
   hide_inactive => {
      text => <<'      END',
         return ( !defined($set->{txn_status}) || $set->{txn_status} ne 'not started' )
             && ( !defined($set->{cmd})        || $set->{cmd} !~ m/Sleep|Binlog Dump/ )
             && ( !defined($set->{info})       || $set->{info} =~ m/\S/               );
      END
      note => 'Removes processes which are not doing anything',
      tbls => [qw(innodb_transactions processlist)],
   },
   hide_slave_io => {
      text => <<'      END',
         return !$set->{state} || $set->{state} !~ m/^(?:Waiting for master|Has read all relay)/;
      END
      note => 'Removes slave I/O threads from the list',
      tbls => [qw(slave_io_status)],
   },
   table_is_open => {
      text => <<'      END',
         return $set->{num_times_open} + $set->{is_name_locked};
      END
      note => 'Removes tables that are not in use or locked',
      tbls => [qw(open_tables)],
   },
   cxn_is_master => {
      text => <<'      END',
         return $set->{master_file} ? 1 : 0;
      END
      note => 'Removes servers that are not masters',
      tbls => [qw(master_status)],
   },
   cxn_is_slave => {
      text => <<'      END',
         return $set->{master_host} ? 1 : 0;
      END
      note => 'Removes servers that are not slaves',
      tbls => [qw(slave_io_status slave_sql_status)],
   },
   thd_is_not_waiting => {
      text => <<'      END',
         return $set->{thread_status} !~ m#waiting for i/o request#;
      END
      note => 'Removes idle I/O threads',
      tbls => [qw(io_threads)],
   },
);
foreach my $key ( keys %builtin_filters ) {
   my ( $sub, $err ) = compile_filter($builtin_filters{$key}->{text});
   $filters{$key} = {
      func => $sub,
      text => $builtin_filters{$key}->{text},
      user => 0,
      name => $key, # useful for later
      note => $builtin_filters{$key}->{note},
      tbls => $builtin_filters{$key}->{tbls},
   }
}

# Variable sets {{{3
# Sets (arrayrefs) of variables that are used in V, S, G mode.  They are read/written to
# the config file.
my %var_sets = (
   general => [ qw( Uptime Questions Com_delete Com_delete_multi Com_insert
            Com_insert_select Com_replace Com_replace_select Com_select
            Com_update Com_update_multi ) ],
   query_status => [ qw( Uptime Select_full_join Select_full_range_join Select_range Select_range_check
            Select_scan Slow_queries Sort_merge_passes Sort_range Sort_rows Sort_scan) ],
   innodb => [ qw( Uptime Innodb_row_lock_current_waits Innodb_row_lock_time
            Innodb_row_lock_time_avg Innodb_row_lock_time_max
            Innodb_row_lock_waits Innodb_rows_deleted Innodb_rows_inserted
            Innodb_rows_read Innodb_rows_updated) ],
   txn => [ qw( Uptime Com_begin Com_commit Com_rollback Com_savepoint
            Com_xa_commit Com_xa_end Com_xa_prepare Com_xa_recover
            Com_xa_rollback Com_xa_start) ],
   key_cache => [ qw( Uptime Key_blocks_not_flushed Key_blocks_unused
            Key_blocks_used Key_read_requests Key_reads Key_write_requests
            Key_writes ) ],
   query_cache => [ qw( Uptime Qcache_free_blocks Qcache_free_memory Qcache_hits
            Qcache_inserts Qcache_lowmem_prunes Qcache_not_cached
            Qcache_queries_in_cache Qcache_total_blocks ) ],
   handler => [ qw( Uptime Handler_read_key Handler_read_first Handler_read_next
            Handler_read_prev Handler_read_rnd Handler_read_rnd_next
            Handler_delete Handler_update Handler_write) ],
   cxns_files_threads => [ qw( Uptime Aborted_clients Aborted_connects Bytes_received
            Bytes_sent Compression Connections Created_tmp_disk_tables
            Created_tmp_files Created_tmp_tables Max_used_connections
            Open_files Open_streams Open_tables Opened_tables
            Table_locks_immediate Table_locks_waited Threads_cached
            Threads_connected Threads_created Threads_running) ],
   prep_stmt => [ qw( Uptime Com_dealloc_sql Com_execute_sql Com_prepare_sql
            Com_reset Com_stmt_close Com_stmt_execute Com_stmt_fetch
            Com_stmt_prepare Com_stmt_reset Com_stmt_send_long_data ) ],
   innodb_health => [ qw(OldVersions IB_sm_mutex_spin_waits IB_sm_mutex_spin_rounds
            IB_sm_mutex_os_waits NumTxns MaxTxnTime IB_ro_queries_inside IB_ro_queries_in_queue
            DirtyBufs BufPoolFill IB_bp_pages_total IB_bp_pages_read IB_bp_pages_written
            IB_bp_pages_created) ],
);

# Server sets {{{3
# Defines sets of servers between which the user can quickly switch.
my %server_groups;

# Connections {{{3
# This hash defines server connections.  Each connection is a string that can be passed to
# the DBI connection.  These are saved in the connections section in the config file.
# Each has dsn, user, pass, savepass properties.
my %connections;
my @conn_parts = qw(user pass dsn savepass dl_table);

# Graph widths {{{3
# This hash defines the max values seen for various status/variable values, for graphing.
# These are stored in their own section in the config file.  These are just initial values:
my %mvs = (
   Com_select   => 50,
   Com_insert   => 50,
   Com_update   => 50,
   Com_delete   => 50,
   Questions    => 100,
);

# Table definitions {{{3
# This hash defines every table that can get displayed in every mode.  Each
# table specifies columns and column data sources.  The column is
# defined by the %columns hash.
#
# Example: foo => { src => 'bar' } means the foo column (look at
# $columns{foo} for its definition) gets its data from the 'bar' element of
# the current data set, whatever that is.
#
# Example 2: biz => { src => \%exprs{bat} } means the expression is
# evaluated for the current data set.
#
# These columns are post-processed after being defined, because they get stuff
# from %columns.  After all the config is loaded for columns, there's more
# post-processing too; the subroutines compiled from src and expr get added to
# the hash elements for extract_values to use.
# ###########################################################################

my %tbl_meta = (
   adaptive_hash_index => {
      hdr  => 'Adaptive Hash Index',
      cols => {
         cxn                 => { src => 'cxn' },
         hash_table_size     => { src => 'IB_ib_hash_table_size', trans => [qw(shorten)], },
         used_cells          => { src => 'IB_ib_used_cells' },
         bufs_in_node_heap   => { src => 'IB_ib_bufs_in_node_heap' },
         hash_searches_s     => { src => 'IB_ib_hash_searches_s' },
         non_hash_searches_s => { src => 'IB_ib_non_hash_searches_s' },
      },
      visible => [ qw(cxn hash_table_size used_cells bufs_in_node_heap hash_searches_s non_hash_searches_s) ],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'ib',
   },
   buffer_pool => {
      hdr  => 'Buffer Pool',
      cols => {
         cxn                        => { src => 'cxn' },
         total_mem_alloc            => { src => 'IB_bp_total_mem_alloc', trans => [qw(shorten)], },
         awe_mem_alloc              => { src => 'IB_bp_awe_mem_alloc', trans => [qw(shorten)], },
         add_pool_alloc             => { src => 'IB_bp_add_pool_alloc', trans => [qw(shorten)], },
         buf_pool_size              => { src => 'IB_bp_buf_pool_size', trans => [qw(shorten)], },
         buf_free                   => { src => 'IB_bp_buf_free' },
         buf_pool_hit_rate          => { src => 'IB_bp_buf_pool_hit_rate' },
         buf_pool_reads             => { src => 'IB_bp_buf_pool_reads' },
         buf_pool_hits              => { src => 'IB_bp_buf_pool_hits' },
         pages_total                => { src => 'IB_bp_pages_total' },
         pages_modified             => { src => 'IB_bp_pages_modified' },
         reads_pending              => { src => 'IB_bp_reads_pending' },
         writes_pending             => { src => 'IB_bp_writes_pending' },
         writes_pending_lru         => { src => 'IB_bp_writes_pending_lru' },
         writes_pending_flush_list  => { src => 'IB_bp_writes_pending_flush_list' },
         writes_pending_single_page => { src => 'IB_bp_writes_pending_single_page' },
         page_creates_sec           => { src => 'IB_bp_page_creates_sec' },
         page_reads_sec             => { src => 'IB_bp_page_reads_sec' },
         page_writes_sec            => { src => 'IB_bp_page_writes_sec' },
         pages_created              => { src => 'IB_bp_pages_created' },
         pages_read                 => { src => 'IB_bp_pages_read' },
         pages_written              => { src => 'IB_bp_pages_written' },
      },
      visible => [ qw(cxn buf_pool_size buf_free pages_total pages_modified buf_pool_hit_rate total_mem_alloc add_pool_alloc)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'bp',
   },
   deadlock_locks => {
      hdr  => 'Deadlock Locks',
      cols => {
         cxn              => { src => 'cxn' },
         mysql_thread_id  => { src => 'mysql_thread_id' },
         dl_txn_num       => { src => 'dl_txn_num' },
         txn_status       => { src => 'txn_status' },
         lock_type        => { src => 'lock_type' },
         space_id         => { src => 'space_id' },
         page_no          => { src => 'page_no' },
         heap_no          => { src => 'heap_no' },
         n_bits           => { src => 'n_bits' },
         index            => { src => 'index' },
         db               => { src => 'db' },
         tbl              => { src => 'table' },
         lock_mode        => { src => 'lock_mode' },
         special          => { src => 'special' },
         insert_intention => { src => 'insert_intention' },
         waiting          => { src => 'waiting' },
         num_locks        => { src => 'num_locks' },
      },
      visible => [ qw(cxn mysql_thread_id txn_status lock_mode db tbl index special insert_intention)],
      filters => [],
      sort_cols => 'cxn mysql_thread_id',
      sort_dir => '1',
      innodb   => 'dl',
   },
   deadlock_transactions => {
      hdr  => 'Deadlock Transactions',
      cols => {
         cxn                => { src => 'cxn' },
         active_secs        => { src => 'active_secs' },
         dl_txn_num         => { src => 'dl_txn_num' },
         has_read_view      => { src => 'has_read_view' },
         heap_size          => { src => 'heap_size' },
         host_and_domain    => { src => 'hostname' },
         hostname           => { src => $exprs{Host}, expr => 'Host' },
         ip                 => { src => 'ip' },
         lock_structs       => { src => 'lock_structs' },
         lock_wait_time     => { src => 'lock_wait_time', trans => [ qw(secs_to_time) ] },
         mysql_thread_id    => { src => 'mysql_thread_id' },
         os_thread_id       => { src => 'os_thread_id' },
         proc_no            => { src => 'proc_no' },
         query_id           => { src => 'query_id' },
         query_status       => { src => 'query_status' },
         query_text         => { src => 'query_text', trans => [ qw(no_ctrl_char) ] },
         tables_in_use      => { src => 'tables_in_use' },
         tables_locked      => { src => 'tables_locked' },
         thread_decl_inside => { src => 'thread_decl_inside' },
         thread_status      => { src => 'thread_status' },
         'time'             => { src => 'active_secs', trans => [ qw(secs_to_time) ] },
         timestring         => { src => 'timestring' },
         txn_doesnt_see_ge  => { src => 'txn_doesnt_see_ge' },
         txn_id             => { src => 'txn_id' },
         txn_sees_lt        => { src => 'txn_sees_lt' },
         txn_status         => { src => 'txn_status' },
         truncates          => { src => 'truncates' },
         undo_log_entries   => { src => 'undo_log_entries' },
         user               => { src => 'user' },
         victim             => { src => 'victim' },
         wait_status        => { src => 'wait_status' },
      },
      visible => [ qw(cxn mysql_thread_id timestring user hostname victim time undo_log_entries lock_structs query_text)],
      filters => [],
      sort_cols => 'cxn mysql_thread_id',
      sort_dir => '1',
      innodb   => 'dl',
   },
   explain => {
      hdr  => 'EXPLAIN Results',
      cols => {
         part_id       => { src => 'id' },
         select_type   => { src => 'select_type' },
         tbl           => { src => 'table' },
         partitions    => { src => 'partitions' },
         scan_type     => { src => 'type' },
         possible_keys => { src => 'possible_keys' },
         index         => { src => 'key' },
         key_len       => { src => 'key_len' },
         index_ref     => { src => 'ref' },
         num_rows      => { src => 'rows' },
         special       => { src => 'Extra' },
      },
      visible => [ qw(select_type tbl partitions scan_type possible_keys index key_len index_ref num_rows special)],
      filters => [],
      sort_cols => '',
      sort_dir => '1',
      innodb   => '',
   },
   file_io_misc => {
      hdr  => 'File I/O Misc',
      cols => {
         cxn            => { src => 'cxn' },
         io_bytes_s     => { src => 'IB_io_avg_bytes_s' },
         io_flush_type  => { src => 'IB_io_flush_type' },
         io_fsyncs_s    => { src => 'IB_io_fsyncs_s' },
         io_reads_s     => { src => 'IB_io_reads_s' },
         io_writes_s    => { src => 'IB_io_writes_s' },
         os_file_reads  => { src => 'IB_io_os_file_reads' },
         os_file_writes => { src => 'IB_io_os_file_writes' },
         os_fsyncs      => { src => 'IB_io_os_fsyncs' },
      },
      visible => [ qw(cxn os_file_reads os_file_writes os_fsyncs io_reads_s io_writes_s io_bytes_s)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'io',
   },
   fk_error => {
      hdr  => 'Foreign Key Error Info',
      cols => {
         timestring   => { src => 'IB_fk_timestring' },
         child_db     => { src => 'IB_fk_child_db' },
         child_table  => { src => 'IB_fk_child_table' },
         child_index  => { src => 'IB_fk_child_index' },
         fk_name      => { src => 'IB_fk_fk_name' },
         parent_db    => { src => 'IB_fk_parent_db' },
         parent_table => { src => 'IB_fk_parent_table' },
         parent_col   => { src => 'IB_fk_parent_col' },
         parent_index => { src => 'IB_fk_parent_index' },
         attempted_op => { src => 'IB_fk_attempted_op' },
      },
      visible => [ qw(timestring child_db child_table child_index parent_db parent_table parent_col parent_index fk_name attempted_op)],
      filters => [],
      sort_cols => '',
      sort_dir => '1',
      innodb   => 'fk',
   },
   insert_buffers => {
      hdr  => 'Insert Buffers',
      cols => {
         cxn           => { src => 'cxn' },
         inserts       => { src => 'IB_ib_inserts' },
         merged_recs   => { src => 'IB_ib_merged_recs' },
         merges        => { src => 'IB_ib_merges' },
         size          => { src => 'IB_ib_size' },
         free_list_len => { src => 'IB_ib_free_list_len' },
         seg_size      => { src => 'IB_ib_seg_size' },
      },
      visible => [ qw(cxn inserts merged_recs merges size free_list_len seg_size)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'ib',
   },
   innodb_transactions => {
      hdr  => 'InnoDB Transactions',
      cols => {
         cxn                => { src => 'cxn' },
         active_secs        => { src => 'active_secs' },
         has_read_view      => { src => 'has_read_view' },
         heap_size          => { src => 'heap_size' },
         hostname           => { src => $exprs{Host}, expr => 'Host' },
         ip                 => { src => 'ip' },
         wait_status        => { src => 'wait_status' },
         lock_wait_time     => { src => 'lock_wait_time', trans => [ qw(secs_to_time) ] },
         lock_structs       => { src => 'lock_structs' },
         mysql_thread_id    => { src => 'mysql_thread_id' },
         os_thread_id       => { src => 'os_thread_id' },
         proc_no            => { src => 'proc_no' },
         query_id           => { src => 'query_id' },
         query_status       => { src => 'query_status' },
         query_text         => { src => 'query_text', trans => [ qw(no_ctrl_char) ]  },
         tables_in_use      => { src => 'tables_in_use' },
         tables_locked      => { src => 'tables_locked' },
         thread_decl_inside => { src => 'thread_decl_inside' },
         thread_status      => { src => 'thread_status' },
         'time'             => { src => 'active_secs', trans => [ qw(secs_to_time) ] },
         txn_doesnt_see_ge  => { src => 'txn_doesnt_see_ge' },
         txn_id             => { src => 'txn_id' },
         txn_sees_lt        => { src => 'txn_sees_lt' },
         txn_status         => { src => 'txn_status', minw => 10, maxw => 10 },
         undo_log_entries   => { src => 'undo_log_entries' },
         user               => { src => 'user', maxw => 10 },
      },
      visible => [ qw(cxn mysql_thread_id user hostname txn_status time undo_log_entries query_text)],
      filters => [ qw( hide_self hide_inactive ) ],
      sort_cols => '-active_secs txn_status cxn mysql_thread_id',
      sort_dir => '1',
      innodb   => 'tx',
      hide_hdr => 1,
      colors   => [
         { col => 'wait_status', op => '>',  arg => 0,             color => 'black on_red' },
         { col => 'time',        op => '>',  arg => 600,           color => 'red' },
         { col => 'time',        op => '>',  arg => 300,           color => 'yellow' },
         { col => 'time',        op => '>',  arg => 30,            color => 'green' },
         { col => 'txn_status',  op => 'eq', arg => 'not started', color => 'white' },
      ],
   },
   io_threads => {
      hdr  => 'I/O Threads',
      cols => {
         cxn            => { src => 'cxn' },
         thread         => { src => 'thread' },
         thread_purpose => { src => 'purpose' },
         event_set      => { src => 'event_set' },
         thread_status  => { src => 'state' },
      },
      visible => [ qw(cxn thread thread_purpose thread_status)],
      filters => [ qw() ],
      sort_cols => 'cxn thread',
      sort_dir => '1',
      innodb   => 'io',
   },
   lock_waits => {
      hdr  => 'Lock Waits',
      cols => {
         cxn              => { src => 'cxn' },
         db               => { src => 'db' },
         index            => { src => 'index' },
         insert_intention => { src => 'insert_intention' },
         lock_mode        => { src => 'lock_mode' },
         lock_type        => { src => 'lock_type' },
         lock_wait_time   => { src => 'lock_wait_time', trans => [ qw(secs_to_time) ] },
         mysql_thread_id  => { src => 'mysql_thread_id' },
         n_bits           => { src => 'n_bits' },
         num_locks        => { src => 'num_locks' },
         page_no          => { src => 'page_no' },
         space_id         => { src => 'space_id' },
         special          => { src => 'special' },
         tbl              => { src => 'table' },
         'time'           => { src => 'active_secs', hdr => 'Active', trans => [ qw(secs_to_time) ] },
         txn_id           => { src => 'txn_id' },
      },
      visible => [ qw(cxn mysql_thread_id lock_wait_time time lock_mode db tbl index insert_intention special)],
      filters => [],
      sort_cols => 'cxn -lock_wait_time',
      sort_dir => '1',
      innodb   => 'tx',
   },
   log_statistics => {
      hdr  => 'Log Statistics',
      cols => {
         cxn                 => { src => 'cxn' },
         last_chkp           => { src => 'IB_lg_last_chkp' },
         log_flushed_to      => { src => 'IB_lg_log_flushed_to' },
         log_ios_done        => { src => 'IB_lg_log_ios_done' },
         log_ios_s           => { src => 'IB_lg_log_ios_s' },
         log_seq_no          => { src => 'IB_lg_log_seq_no' },
         pending_chkp_writes => { src => 'IB_lg_pending_chkp_writes' },
         pending_log_writes  => { src => 'IB_lg_pending_log_writes' },
      },
      visible => [ qw(cxn log_seq_no log_flushed_to last_chkp log_ios_done log_ios_s)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'lg',
   },
   master_status => {
      hdr  => 'Master Status',
      cols => {
         cxn                         => { src => 'cxn' },
         binlog_do_db                => { src => 'Binlog_Do_DB' },
         binlog_ignore_db            => { src => 'Binlog_Ignore_DB' },
         master_file                 => { src => 'File' },
         master_pos                  => { src => 'Position' },
      },
      visible => [ qw(cxn master_file master_pos)],
      filters => [ qw(cxn_is_master) ],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => '',
   },
   pending_io => {
      hdr  => 'Pending I/O',
      cols => {
         cxn                => { src => 'cxn' },
         p_normal_aio_reads => { src => 'IB_io_pending_normal_aio_reads' },
         p_aio_writes       => { src => 'IB_io_pending_aio_writes' },
         p_ibuf_aio_reads   => { src => 'IB_io_pending_ibuf_aio_reads' },
         p_sync_ios         => { src => 'IB_io_pending_sync_ios' },
         p_buf_pool_flushes => { src => 'IB_io_pending_buffer_pool_flushes' },
         p_log_flushes      => { src => 'IB_io_pending_log_flushes' },
         p_log_ios          => { src => 'IB_io_pending_log_ios' },
         p_preads           => { src => 'IB_io_pending_preads' },
         p_pwrites          => { src => 'IB_io_pending_pwrites' },
      },
      visible => [ qw(cxn p_normal_aio_reads p_aio_writes p_ibuf_aio_reads p_sync_ios p_log_flushes p_log_ios)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'io',
   },
   open_tables => {
      hdr  => 'Open Tables',
      cols => {
         cxn            => { src => 'cxn' },
         db             => { src => 'Database' },
         tbl            => { src => 'Table' },
         num_times_open => { src => 'In_use' },
         is_name_locked => { src => 'Name_locked' },
      },
      visible => [ qw(cxn db tbl num_times_open is_name_locked)],
      filters => [ qw(table_is_open) ],
      sort_cols => '-num_times_open cxn db tbl',
      sort_dir => '1',
      innodb   => '',
   },
   page_statistics => {
      hdr  => 'Page Statistics',
      cols => {
         cxn              => { src => 'cxn' },
         pages_read       => { src => 'IB_bp_pages_read' },
         pages_written    => { src => 'IB_bp_pages_written' },
         pages_created    => { src => 'IB_bp_pages_created' },
         page_reads_sec   => { src => 'IB_bp_page_reads_sec' },
         page_writes_sec  => { src => 'IB_bp_page_writes_sec' },
         page_creates_sec => { src => 'IB_bp_page_creates_sec' },
      },
      visible => [ qw(cxn pages_read pages_written pages_created page_reads_sec page_writes_sec page_creates_sec)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'bp',
   },
   processlist => {
      hdr  => 'MySQL Process List',
      cols => {
         cxn             => { src => 'cxn',        minw => 6,  maxw => 10 },
         mysql_thread_id => { src => 'Id',         minw => 6,  maxw => 0 },
         user            => { src => 'User',       minw => 5,  maxw => 8 },
         hostname        => { src => $exprs{Host}, minw => 13, maxw => 8, expr => 'Host' },
         port            => { src => $exprs{Port}, minw => 0,  maxw => 0, expr => 'Port' },
         host_and_port   => { src => 'Host',       minw => 0,  maxw => 0 },
         db              => { src => 'db',         minw => 6,  maxw => 12 },
         cmd             => { src => 'Command',    minw => 5,  maxw => 0 },
         time            => { src => 'Time',       minw => 5,  maxw => 0, trans => [ qw(secs_to_time) ] },
         state           => { src => 'State',      minw => 0,  maxw => 0 },
         info            => { src => 'Info',       minw => 0,  maxw => 0, trans => [ qw(no_ctrl_char) ] },
      },
      visible => [ qw(cxn mysql_thread_id user hostname db time info)],
      filters => [ qw(hide_self hide_inactive hide_slave_io) ],
      sort_cols => '-time cxn hostname mysql_thread_id',
      sort_dir => '1',
      innodb   => '',
      hide_hdr => 1,
      colors   => [
         { col => 'cmd',         op => 'eq', arg => 'Locked',      color => 'red' },
         { col => 'cmd',         op => 'eq', arg => 'Query',       color => 'yellow' },
         { col => 'cmd',         op => 'eq', arg => 'Sleep',       color => 'white' },
         { col => 'user',        op => 'eq', arg => 'system user', color => 'white' },
         { col => 'cmd',         op => 'eq', arg => 'Connect',     color => 'green' },
         { col => 'cmd',         op => 'eq', arg => 'Binlog Dump', color => 'white' },
      ],
   },
   q_header => {
      hdr  => 'Q-mode Header',
      cols => {
         cxn            => { src => 'cxn' },
         questions      => { src => 'Questions' },
         qps            => { src => 'Questions/Uptime_hires',                       trans => [qw(shorten)] },
         slow           => { src => 'Slow_queries',                                 trans => [qw(shorten)] },
         q_cache_hit    => { src => 'Qcache_hits/Com_select',                       trans => [qw(percent)] },
         key_buffer_hit => { src => '1-(Key_reads/Key_read_requests)',              trans => [qw(percent)] },
         bps_in         => { src => 'Bytes_received/Uptime_hires',                  trans => [qw(shorten)] },
         bps_out        => { src => 'Bytes_sent/Uptime_hires',                      trans => [qw(shorten)] },
         when           => { src => 'when' },
      },
      visible => [ qw(cxn when qps slow q_cache_hit key_buffer_hit bps_in bps_out)],
      filters => [],
      sort_cols => 'when cxn',
      sort_dir => '1',
      innodb   => '',
      hide_hdr => 1,
   },
   row_operations => {
      hdr  => 'InnoDB Row Operations',
      cols => {
         cxn         => { src => 'cxn' },
         num_inserts => { src => 'IB_ro_num_rows_ins' },
         num_updates => { src => 'IB_ro_num_rows_upd' },
         num_reads   => { src => 'IB_ro_num_rows_read' },
         num_deletes => { src => 'IB_ro_num_rows_del' },
         num_inserts_sec => { src => 'IB_ro_ins_sec' },
         num_updates_sec => { src => 'IB_ro_upd_sec' },
         num_reads_sec   => { src => 'IB_ro_read_sec' },
         num_deletes_sec => { src => 'IB_ro_del_sec' },
      },
      visible => [ qw(cxn num_inserts num_updates num_reads num_deletes num_inserts_sec
                       num_updates_sec num_reads_sec num_deletes_sec)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'ro',
   },
   row_operation_misc => {
      hdr  => 'Row Operation Misc',
      cols => {
         cxn                 => { src => 'cxn' },
         queries_in_queue    => { src => 'IB_ro_queries_in_queue' },
         queries_inside      => { src => 'IB_ro_queries_inside' },
         read_views_open     => { src => 'IB_ro_read_views_open' },
         main_thread_id      => { src => 'IB_ro_main_thread_id' },
         main_thread_proc_no => { src => 'IB_ro_main_thread_proc_no' },
         main_thread_state   => { src => 'IB_ro_main_thread_state' },
         num_res_ext         => { src => 'IB_ro_n_reserved_extents' },
      },
      visible => [ qw(cxn queries_in_queue queries_inside read_views_open main_thread_state)],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'ro',
   },
   semaphores => {
      hdr  => 'InnoDB Semaphores',
      cols => {
         cxn                => { src => 'cxn' },
         mutex_os_waits     => { src => 'IB_sm_mutex_os_waits' },
         mutex_spin_rounds  => { src => 'IB_sm_mutex_spin_rounds' },
         mutex_spin_waits   => { src => 'IB_sm_mutex_spin_waits' },
         reservation_count  => { src => 'IB_sm_reservation_count' },
         rw_excl_os_waits   => { src => 'IB_sm_rw_excl_os_waits' },
         rw_excl_spins      => { src => 'IB_sm_rw_excl_spins' },
         rw_shared_os_waits => { src => 'IB_sm_rw_shared_os_waits' },
         rw_shared_spins    => { src => 'IB_sm_rw_shared_spins' },
         signal_count       => { src => 'IB_sm_signal_count' },
         wait_array_size    => { src => 'IB_sm_wait_array_size' },
      },
      visible => [ qw(cxn mutex_os_waits mutex_spin_waits mutex_spin_rounds
         rw_excl_os_waits rw_excl_spins rw_shared_os_waits rw_shared_spins
         signal_count reservation_count )],
      filters => [],
      sort_cols => 'cxn',
      sort_dir => '1',
      innodb   => 'sm',
   },
   slave_io_status => {
      hdr  => 'Slave I/O Status',
      cols => {
         cxn                         => { src => 'cxn' },
         connect_retry               => { src => 'Connect_Retry' },
         master_host                 => { src => 'Master_Host', hdr => 'Master'},
         master_log_file             => { src => 'Master_Log_File', hdr => 'File' },
         master_port                 => { src => 'Master_Port' },
         master_ssl_allowed          => { src => 'Master_SSL_Allowed' },
         master_ssl_ca_file          => { src => 'Master_SSL_CA_File' },
         master_ssl_ca_path          => { src => 'Master_SSL_CA_Path' },
         master_ssl_cert             => { src => 'Master_SSL_Cert' },
         master_ssl_cipher           => { src => 'Master_SSL_Cipher' },
         master_ssl_key              => { src => 'Master_SSL_Key' },
         master_user                 => { src => 'Master_User' },
         read_master_log_pos         => { src => 'Read_Master_Log_Pos', hdr => 'Pos' },
         relay_log_size              => { src => 'Relay_Log_Space', trans => [qw(shorten)] },
         slave_io_running            => { src => 'Slave_IO_Running', hdr => 'On?' },
         slave_io_state              => { src => 'Slave_IO_State', hdr => 'State' },
      },
      visible => [ qw(cxn master_host slave_io_running master_log_file relay_log_size read_master_log_pos slave_io_state)],
      filters => [ qw( cxn_is_slave ) ],
      sort_cols => 'slave_io_running cxn',
      colors   => [
         { col => 'slave_io_running',  op => 'ne', arg => 'Yes', color => 'black on_red' },
      ],
      sort_dir => '1',
      innodb   => '',
   },
   slave_sql_status => {
      hdr  => 'Slave SQL Status',
      cols => {
         cxn                         => { src => 'cxn' },
         exec_master_log_pos         => { src => 'Exec_Master_Log_Pos', hdr => 'Master Pos' },
         last_errno                  => { src => 'Last_Errno' },
         last_error                  => { src => 'Last_Error' },
         master_host                 => { src => 'Master_Host', hdr => 'Master' },
         relay_log_file              => { src => 'Relay_Log_File' },
         relay_log_pos               => { src => 'Relay_Log_Pos' },
         relay_log_size              => { src => 'Relay_Log_Space', trans => [qw(shorten)] },
         relay_master_log_file       => { src => 'Relay_Master_Log_File', hdr => 'Master File' },
         replicate_do_db             => { src => 'Replicate_Do_DB' },
         replicate_do_table          => { src => 'Replicate_Do_Table' },
         replicate_ignore_db         => { src => 'Replicate_Ignore_DB' },
         replicate_ignore_table      => { src => 'Replicate_Ignore_Table' },
         replicate_wild_do_table     => { src => 'Replicate_Wild_Do_Table' },
         replicate_wild_ignore_table => { src => 'Replicate_Wild_Ignore_Table' },
         skip_counter                => { src => 'Skip_Counter' },
         slave_sql_running           => { src => 'Slave_SQL_Running', hdr => 'On?' },
         until_condition             => { src => 'Until_Condition' },
         until_log_file              => { src => 'Until_Log_File' },
         until_log_pos               => { src => 'Until_Log_Pos' },
         time_behind_master          => { src => 'Seconds_Behind_Master', trans => [ qw(secs_to_time) ] },
         bytes_behind_master         => { src => $exprs{ReplByteLag}, trans => [qw(shorten)], expr => 'ReplByteLag' },
         slave_open_temp_tables      => { src => 'Slave_open_temp_tables' },
      },
      visible => [ qw(cxn master_host slave_sql_running time_behind_master slave_open_temp_tables relay_log_pos last_error)],
      filters => [ qw( cxn_is_slave ) ],
      sort_cols => 'slave_sql_running cxn',
      sort_dir => '1',
      innodb   => '',
      colors   => [
         { col => 'slave_sql_running',  op => 'ne', arg => 'Yes', color => 'black on_red' },
         { col => 'time_behind_master', op => '>',  arg => 600,   color => 'red' },
         { col => 'time_behind_master', op => '>',  arg => 60,    color => 'yellow' },
         { col => 'time_behind_master', op => '==', arg => 0,     color => 'white' },
      ],
   },
   wait_array => {
      hdr  => 'InnoDB Wait Array',
      cols => {
         cxn                => { src => 'cxn' },
         thread             => { src => 'thread' },
         waited_at_filename => { src => 'waited_at_filename' },
         waited_at_line     => { src => 'waited_at_line' },
         'time'             => { src => 'waited_secs', trans => [ qw(secs_to_time) ] },
         request_type       => { src => 'request_type' },
         lock_mem_addr      => { src => 'lock_mem_addr' },
         lock_cfile_name    => { src => 'lock_cfile_name' },
         lock_cline         => { src => 'lock_cline' },
         writer_thread      => { src => 'writer_thread' },
         writer_lock_mode   => { src => 'writer_lock_mode' },
         num_readers        => { src => 'num_readers' },
         lock_var           => { src => 'lock_var' },
         waiters_flag       => { src => 'waiters_flag' },
         last_s_file_name   => { src => 'last_s_file_name' },
         last_s_line        => { src => 'last_s_line' },
         last_x_file_name   => { src => 'last_x_file_name' },
         last_x_line        => { src => 'last_x_line' },
         cell_waiting       => { src => 'cell_waiting' },
         cell_event_set     => { src => 'cell_event_set' },
      },
      visible => [ qw(cxn thread time waited_at_filename waited_at_line request_type num_readers lock_var waiters_flag cell_waiting cell_event_set)],
      filters => [],
      sort_cols => 'cxn -time',
      sort_dir => '1',
      innodb   => 'sm',
   },
);

# TODO: V, G, S mode should have a table in tbl_meta

# Initialize %tbl_meta from %columns
foreach my $table ( values %tbl_meta ) {
   foreach my $col_name ( keys %{$table->{cols}} ) {
      my $col_def = $table->{cols}->{$col_name};
      die "I can't find a column named '$col_name'" unless $columns{$col_name};

      foreach my $prop ( keys %col_props ) {
         # Each column gets non-existing values set from %columns or defaults from %col_props.
         if ( !$col_def->{$prop} ) {
            $col_def->{$prop}
               = defined($columns{$col_name}->{$prop})
               ? $columns{$col_name}->{$prop}
               : $col_props{$prop};
         }
      }
   }
   # Compile sort and color subroutines
   $table->{sort_func}  = make_sort_func($table);
   $table->{color_func} = make_color_func($table);
}

# ###########################################################################
# Valid Term::ANSIColor color strings.
# ###########################################################################
my %ansicolors = map { $_ => 1 }
   qw( black blink blue bold clear concealed cyan dark green magenta on_black
       on_blue on_cyan on_green on_magenta on_red on_white on_yellow red reset
       reverse underline underscore white yellow);

# ###########################################################################
# Valid comparison operators for color rules
# ###########################################################################
my %comp_ops = (
   '==' => 'Numeric equality',
   '>'  => 'Numeric greater-than',
   '<'  => 'Numeric less-than',
   '>=' => 'Numeric greater-than/equal',
   '<=' => 'Numeric less-than/equal',
   '!=' => 'Numeric not-equal',
   'eq' => 'String equality',
   'gt' => 'String greater-than',
   'lt' => 'String less-than',
   'ge' => 'String greater-than/equal',
   'le' => 'String less-than/equal',
   'ne' => 'String not-equal',
   '=~' => 'Pattern match',
   '!~' => 'Negated pattern match',
);

# ###########################################################################
# Valid functions for transformations.
# ###########################################################################
my %trans_funcs = (
   shorten      => \&shorten,
   secs_to_time => \&secs_to_time,
   no_ctrl_char => \&no_ctrl_char,
   percent      => \&percent,
   commify      => \&commify,
   collapse_ws  => \&collapse_ws,
   dulint_to_int => \&dulint_to_int,
);

# ###########################################################################
# Operating modes {{{3
# ###########################################################################
my %modes = (
   B => {
      hdr               => 'InnoDB Buf',
      note              => 'Shows buffer info from InnoDB',
      action_for        => {
         i => {
            action => sub { toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
      },
      display_sub       => \&display_B,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(buffer_pool page_statistics insert_buffers adaptive_hash_index)],
      visible_tables    => [qw(buffer_pool page_statistics insert_buffers adaptive_hash_index)],
   },
   D => {
      hdr               => 'InnoDB Deadlocks',
      note              => 'View InnoDB deadlock information',
      action_for        => {
         w => {
            action => \&create_deadlock,
            label  => 'Wipe deadlock status info by creating a deadlock',
         },
      },
      display_sub       => \&display_D,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(deadlock_transactions deadlock_locks)],
      visible_tables    => [qw(deadlock_transactions deadlock_locks)],
   },
   F => {
      hdr               => 'InnoDB FK Err',
      note              => 'View the latest InnoDB foreign key error',
      action_for        => {},
      display_sub       => \&display_F,
      connections       => [],
      server_group      => '',
      one_connection    => 1,
      tables            => [qw(fk_error)],
      visible_tables    => [qw(fk_error)],
   },
   G => {
      hdr               => 'Load Graph',
      note              => 'Shows query load graph',
      action_for        => {
         c => {
            action => sub {
               choose_var_set('G_set');
               start_G_mode();
            },
            label => "Choose which set to display",
         },
         e => {
            action => \&edit_current_var_set,
            label  => 'Edit the current set of variables',
         },
         i => {
            action => sub { $clear_screen_sub->(); toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
      },
      display_sub       => \&display_G,
      no_clear_screen   => 1,
      connections       => [],
      server_group      => '',
      one_connection    => 1,
      tables            => [qw()],
      visible_tables    => [qw()],
   },
   I => {
      hdr               => 'InnoDB I/O Info',
      note              => 'Shows I/O info (i/o, log...) from InnoDB',
      action_for        => {
         i => {
            action => sub { toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
      },
      display_sub       => \&display_I,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(io_threads pending_io file_io_misc log_statistics)],
      visible_tables    => [qw(io_threads pending_io file_io_misc log_statistics)],
   },
   M => {
      hdr               => 'Replication Status',
      note              => 'Shows replication (master and slave) status',
      action_for        => {
         a => {
            action => sub { send_cmd_to_servers('START SLAVE', 1, 'START SLAVE SQL_THREAD UNTIL MASTER_LOG_FILE = ?, MASTER_LOG_POS = ?'); },
            label  => 'Start slave(s)',
         },
         i => {
            action => sub { toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
         o => {
            action => sub { send_cmd_to_servers('STOP SLAVE', 1); },
            label  => 'Stop slave(s)',
         },
      },
      display_sub       => \&display_M,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(slave_sql_status slave_io_status master_status)],
      visible_tables    => [qw(slave_sql_status slave_io_status master_status)],
   },
   O => {
      hdr               => 'Open Tables',
      note              => 'Shows open tables in MySQL',
      action_for        => {
         c => {
            action => sub { get_config_interactive('O_fmt'); },
            label => "Choose which columns to display",
         },
         r => {
            action => sub { reverse_sort('open_tables'); },
            label  => 'Reverse sort order',
         },
         s => {
            action => sub { choose_sort_cols('open_tables'); },
            label => "Choose sort column",
         },
      },
      display_sub       => \&display_O,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(open_tables)],
      visible_tables    => [qw(open_tables)],
   },
   Q => {
      hdr        => 'Query List',
      note       => 'Shows queries from SHOW FULL PROCESSLIST',
      action_for => {
         a => {
            action => sub { toggle_filter('processlist', 'hide_self') },
            label  => 'Toggle hiding the innotop process',
         },
         c => {
            action => sub { choose('Q_fmt'); },
            label => "Choose which columns to display",
         },
         e => {
            action => sub { analyze_query('e'); },
            label  => "Explain a thread's query",
         },
         f => {
            action => sub { analyze_query('f'); },
            label  => "Show a thread's full query",
         },
         h => {
            action => sub { toggle_config('show_QT_header') },
            label  => 'Toggle the header on and off',
         },
         i => {
            action => sub { toggle_filter('processlist', 'hide_inactive') },
            label  => 'Toggle showing or hiding idle (Sleep) processes',
         },
         k => {
            action => sub { kill_query('CONNECTION') },
            label => "Kill a query's connection",
         },
         r => {
            action => sub { reverse_sort('processlist'); },
            label  => 'Reverse sort order',
         },
         s => {
            action => sub { choose_sort_cols('processlist'); },
            label => "Change the display's sort column",
         },
         x => {
            action => sub { kill_query('QUERY') },
            label => "Kill a query (not the connection; requires 5.0)",
         },
      },
      display_sub       => \&display_Q,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(q_header processlist)],
      visible_tables    => [qw(q_header processlist)],
   },
   R => {
      hdr               => 'InnoDB Row Ops',
      note              => 'Shows InnoDB row operation and semaphore info',
      action_for        => {
         i => {
            action => sub { toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
      },
      display_sub       => \&display_R,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(row_operations row_operation_misc semaphores wait_array)],
      visible_tables    => [qw(row_operations row_operation_misc semaphores wait_array)],
   },
   S => {
      hdr               => 'Load Stats',
      note              => 'Shows query load statistics a la vmstat',
      action_for        => {
         c => {
            action => sub {
               choose_var_set('S_set');
               start_S_mode();
            },
            label => "Choose which set to display",
         },
         e => {
            action => \&edit_current_var_set,
            label  => 'Edit the current set of variables',
         },
         i => {
            action => sub { $clear_screen_sub->(); toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
         '-' => {
            action => sub { set_display_precision(-1) },
            label  => 'Decrease fractional display precision',
         },
         '+' => {
            action => sub { set_display_precision(1) },
            label  => 'Increase fractional display precision',
         },
      },
      display_sub       => \&display_S,
      no_clear_screen   => 1,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw()],
      visible_tables    => [qw()],
   },
   T => {
      hdr        => 'InnoDB Txns',
      note       => 'Shows InnoDB transactions in top-like format',
      action_for => {
         a => {
            action => sub { toggle_filter('innodb_transactions', 'hide_self') },
            label  => 'Toggle hiding the innotop process',
         },
         c => {
            action => sub { get_config_interactive('T_fmt'); },
            label => "Choose which columns to display",
         },
         h => {
            action => sub { toggle_config('show_QT_header') },
            label  => 'Toggle the header on and off',
         },
         i => {
            action => sub { toggle_filter('innodb_transactions', 'hide_inactive') },
            label  => 'Toggle showing or hiding inactive transactions',
         },
         k => {
            action => sub { kill_query('CONNECTION') },
            label  => "Kill a transaction's connection",
         },
         r => {
            action => sub { reverse_sort('innodb_transactions'); },
            label  => 'Reverse sort order',
         },
         s => {
            action => sub { choose_sort_cols('innodb_transactions'); },
            label  => "Change the display's sort column",
         },
         x => {
            action => sub { kill_query('QUERY') },
            label  => "Kill a query, not a connection (requires 5.0)",
         },
      },
      display_sub       => \&display_T,
      connections       => [],
      server_group      => '',
      one_connection    => 0,
      tables            => [qw(innodb_transactions)],
      visible_tables    => [qw(innodb_transactions)],
   },
   V => {
      hdr               => 'Variables & Status',
      note              => 'Shows values from SHOW STATUS and SHOW VARIABLES',
      action_for        => {
         c => {
            action => sub { choose_var_set('V_set') },
            label  => 'Choose which set to display',
         },
         e => {
            action => \&edit_current_var_set,
            label  => 'Edit the current set of variables',
         },
         i => {
            action => sub { toggle_config('status_inc') },
            label  => 'Toggle overall/incremental status display',
         },
         '-' => {
            action => sub { set_display_precision(-1) },
            label  => 'Decrease fractional display precision',
         },
         '+' => {
            action => sub { set_display_precision(1) },
            label  => 'Increase fractional display precision',
         },
      },
      display_sub    => \&display_V,
      connections    => [],
      server_group   => '',
      one_connection => 1,
      tables            => [qw()],
      visible_tables    => [qw()],
   },
   W => {
      hdr             => 'InnoDB Lock Waits',
      note            => 'Shows transaction lock waits and OS wait array info',
      action_for      => {
         c => {
            action => sub { get_config_interactive('W_fmt') },
            label  => 'Choose which columns to show in the lock waits table',
         },
      },
      display_sub     => \&display_W,
      connections     => [],
      server_group    => '',
      one_connection  => 0,
      tables            => [qw(lock_waits wait_array)],
      visible_tables    => [qw(lock_waits wait_array)],
   },
);

# ###########################################################################
# Global key mappings {{{3
# Keyed on a single character, which is read from the keyboard.  Uppercase
# letters switch modes.  Lowercase letters access commands when in a mode.
# These can be overridden by action_for in %modes.
# ###########################################################################
my %action_for = (
   '$' => {
      action => \&edit_configuration,
      label  => 'Edit configuration settings',
   },
   '?' => {
      action => \&display_help,
      label  => 'Show help',
   },
   '!' => {
      action => \&display_license,
      label  => 'Show license and warranty information',
   },
   '^' => {
      action => \&edit_table,
      label  => "Edit columns, etc in the displayed table(s)",
   },
   '#' => {
      action => \&choose_server_groups,
      label  => 'Select/create server groups',
   },
   '@' => {
      action => \&choose_servers,
      label  => 'Select/create server connections',
   },
   "\t" => {
      action => \&next_server_group,
      label  => 'Switch to the next server group',
      key    => 'TAB',
   },
   B => {
      action => sub { switch_mode('B') },
      label  => 'Switch to B mode (InnoDB Buffer/Hash Index)',
   },
   D => {
      action => sub { switch_mode('D') },
      label  => 'Switch to D mode (InnoDB Deadlock Information)',
   },
   F => {
      action => sub { switch_mode('F') },
      label  => 'Switch to F mode (InnoDB Foreign Key Error)',
   },
   G => {
      action => \&start_G_mode,
      label  => 'Switch to G mode (Load Graph)',
   },
   I => {
      action => sub { switch_mode('I') },
      label  => 'Switch to I mode (InnoDB I/O and Log)',
   },
   M => {
      action => sub { switch_mode('M') },
      label  => 'Switch to M mode (MySQL Replication Status)',
   },
   O => {
      action => sub { switch_mode('O') },
      label  => 'Switch to O mode (MySQL Open Tables)',
   },
   Q => {
      action => sub { switch_mode('Q') },
      label  => 'Switch to Q mode (Query List, like mytop)',
   },
   R => {
      action => sub { switch_mode('R') },
      label  => 'Switch to R mode (InnoDB Row Operations)',
   },
   S => {
      action => \&start_S_mode,
      label  => 'Switch to S mode (Load Statistics)',
   },
   T => {
      action => sub { switch_mode('T') },
      label  => 'Switch to T mode (InnoDB Transaction)',
   },
   V => {
      action => sub { switch_mode('V') },
      label  => 'Switch to V mode (Variable & Status)',
   },
   W => {
      action => sub { switch_mode('W') },
      label  => 'Switch to W mode (InnoDB Lock Waits and OS Wait Info)',
   },
   d => {
      action => sub { get_config_interactive('interval') },
      label  => 'Change refresh interval',
   },
   p => { action => \&pause,             label => 'Pause innotop', },
   q => { action => \&finish,            label => 'Quit innotop', },
);

# ###########################################################################
# Config editor key mappings {{{3
# ###########################################################################
my %cfg_editor_action = (
   c => {
      note => 'Edit columns, etc in the displayed table(s)',
      func => \&edit_table,
   },
   g => {
      note => 'Edit general configuration',
      func => \&edit_configuration_variables,
   },
   k => {
      note => 'Edit row-coloring rules',
      func => \&edit_color_rules,
   },
   s => {
      note => 'Edit server groups',
      func => \&edit_server_groups,
   },
   t => {
      note => 'Choose which table(s) to display in this mode',
      func => \&choose_mode_tables,
   },
);

# ###########################################################################
# Color editor key mappings {{{3
# ###########################################################################
my %color_editor_action = (
   n => {
      note => 'Create a new color rule',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my $meta = $tbl_meta{$tbl};

         $clear_screen_sub->();
         my $col;
         do {
            $col = prompt_list(
               'Choose the target column for the rule',
               '',
               sub { return keys %{$meta->{cols}} },
               { map { $_ => $meta->{cols}->{$_}->{label} } keys %{$meta->{cols}} });
         } while ( !$col );
         ( $col ) = grep { $_ } split(/\W+/, $col);
         return $idx unless $col && exists $meta->{cols}->{$col};

         $clear_screen_sub->();
         my $op;
         do {
            $op = prompt_list(
               'Choose the comparison operator for the rule',
               '',
               sub { return keys %comp_ops },
               { map { $_ => $comp_ops{$_} } keys %comp_ops } );
         } until ( $op );
         $op =~ s/\s+//g;
         return $idx unless $op && exists $comp_ops{$op};

         my $arg;
         do {
            $arg = prompt('Specify an argument for the comparison');
         } until defined $arg;

         my $color;
         do {
            $color = prompt_list(
               'Choose the color(s) the row should be when the rule matches',
               '',
               sub { return keys %ansicolors },
               { map { $_ => $_ } keys %ansicolors } );
         } until defined $color;
         $color = join(' ', unique(grep { exists $ansicolors{$_} } split(/\W+/, $color)));
         return $idx unless $color;

         push @{$tbl_meta{$tbl}->{colors}}, {
            col   => $col,
            op    => $op,
            arg   => $arg,
            color => $color
         };

         return $idx;
      },
   },
   d => {
      note => 'Remove the selected rule',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my @rules = @{ $tbl_meta{$tbl}->{colors} };
         return 0 unless @rules > 0 && $idx < @rules && $idx >= 0;
         splice(@{$tbl_meta{$tbl}->{colors}}, $idx, 1);
         return $idx == @rules ? $#rules : $idx;
      },
   },
   j => {
      note => 'Move highlight down one',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my $num_rules = scalar @{$tbl_meta{$tbl}->{colors}};
         return ($idx + 1) % $num_rules;
      },
   },
   k => {
      note => 'Move highlight up one',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my $num_rules = scalar @{$tbl_meta{$tbl}->{colors}};
         return ($idx - 1) % $num_rules;
      },
   },
   '+' => {
      note => 'Move selected rule up one',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my $meta = $tbl_meta{$tbl};
         my $dest = $idx == 0 ? scalar(@{$meta->{colors}} - 1) : $idx - 1;
         my $temp = $meta->{colors}->[$idx];
         $meta->{colors}->[$idx]  = $meta->{colors}->[$dest];
         $meta->{colors}->[$dest] = $temp;
         return $dest;
      },
   },
   '-' => {
      note => 'Move selected rule down one',
      func => sub {
         my ( $tbl, $idx ) = @_;
         my $meta = $tbl_meta{$tbl};
         my $dest = $idx == scalar(@{$meta->{colors}} - 1) ? 0 : $idx + 1;
         my $temp = $meta->{colors}->[$idx];
         $meta->{colors}->[$idx]  = $meta->{colors}->[$dest];
         $meta->{colors}->[$dest] = $temp;
         return $dest;
      },
   },
);

# ###########################################################################
# Table editor key mappings {{{3
# ###########################################################################
my %tbl_editor_action = (
   a => {
      note => 'Add a column to the table',
      func => sub {
         my ( $tbl, $col ) = @_;
         my @visible_cols = @{ $tbl_meta{$tbl}->{visible} };
         my %all_cols     = %{ $tbl_meta{$tbl}->{cols} };
         delete @all_cols{@visible_cols};
         my $choice = prompt_list(
            'Choose a column',
            '',
            sub { return keys %all_cols; },
            { map { $_ => $all_cols{$_}->{label} || $all_cols{$_}->{hdr} } keys %all_cols });
         if ( $all_cols{$choice} ) {
            push @{$tbl_meta{$tbl}->{visible}}, $choice;
            return $choice;
         }
         return $col;
      },
   },
   n => {
      note => 'Create a new column and add it to the table',
      func => sub {
         my ( $tbl, $col ) = @_;

         $clear_screen_sub->();
         print word_wrap("Choose a name for the column.  This name is not displayed, and is only used "
               . "for internal reference.  It can only contain lowercase letters, numbers, "
               . "and underscores.");
         print "\n\n";
         do {
            $col = prompt("Enter column name");
            $col = '' if $col =~ m/[^a-z0-9_]/;
         } while ( !$col );

         $clear_screen_sub->();
         my $hdr;
         do {
            $hdr = prompt("Enter column header");
         } while ( !$hdr );

         $clear_screen_sub->();
         print word_wrap("Choose a source for the column's data.  You can either enter the name of an entry "
               . "in the data available to the table (varies by context) or if you want to enter "
               . "the name of an expression, specify nothing here.");
         print "\n\n";
         my ( $src, $sub, $err );
         do {
            if ( $err ) {
               print "Error: $err\n\n";
            }
            $src = prompt("Enter column source");
            if ( $src ) {
               ( $sub, $err ) = compile_expr($src, 1);
            }
         } until ( !$src || !$err);

         my $exp;
         if ( !$src ) {
            $exp = get_expr();
            return $col unless $exp && $exprs{$exp};
         }

         $tbl_meta{$tbl}->{cols}->{$col} = {
            hdr   => $hdr,
            src   => $src,
            just  => '-',
            num   => 0,
            label => 'User-defined',
            user  => 1,
            tbl   => $tbl,
            expr  => $exp ? $exp : '',
            minw  => 0,
            maxw  => 0,
            trans => [],
            func  => $sub || $exprs{$exp}->{func},
         };

         $tbl_meta{$tbl}->{visible} = [ unique(@{$tbl_meta{$tbl}->{visible}}, $col) ];
         return $col;
      },
   },
   d => {
      note => 'Remove selected column',
      func => sub {
         my ( $tbl, $col ) = @_;
         my @visible_cols = @{ $tbl_meta{$tbl}->{visible} };
         my $idx          = 0;
         return $col unless @visible_cols > 1;
         while ( $visible_cols[$idx] ne $col ) {
            $idx++;
         }
         $tbl_meta{$tbl}->{visible} = [ grep { $_ ne $col } @visible_cols ];
         return $idx == $#visible_cols ? $visible_cols[$idx - 1] : $visible_cols[$idx + 1];
      },
   },
   e => {
      note => 'Edit selected column',
      func => sub {
         my ( $tbl, $col ) = @_;
         $clear_screen_sub->();
         my $meta = $tbl_meta{$tbl}->{cols}->{$col};
         my @prop = qw(hdr label src expr just num minw maxw trans);

         my $answer;
         do {
            # Do what the user asked...
            if ( $answer && grep { $_ eq $answer } @prop ) {
               if ( $answer eq 'expr' ) {
                  $meta->{expr} = get_expr();
               }
               else {
                  # Some properties are arrays, others scalars.
                  my $ini = ref $col_props{$answer} ? join(' ', @{$meta->{$answer}}) : $meta->{$answer};
                  my $val = prompt("New value for $answer", undef, $ini);
                  $val = [ split(' ', $val) ] if ref($col_props{$answer});
                  if ( $answer eq 'trans' ) {
                     $val = [ unique(grep{ exists $trans_funcs{$_} } @$val) ];
                  }
                  @{$meta}{$answer, 'user', 'tbl' } = ( $val, 1, $tbl );
                  if ( $answer eq 'src' ) {
                     $meta->{expr} = '';
                  }
               }
               if ( $meta->{expr} ) {
                  $meta->{src}  = $exprs{$meta->{expr}};
               }
            }

            my @display_lines = (
               '',
               "You are editing column $tbl.$col.\n",
            );

            push @display_lines, create_table2(
               \@prop,
               { map { $_ => $_ } @prop },
               { map { $_ => ref $meta->{$_} eq 'ARRAY' ? join(' ', @{$meta->{$_}})
                           : ref $meta->{$_}            ? '[expression code]'
                           :                              $meta->{$_}
                     } @prop
               },
               { sep => '  ' });
            draw_screen(\@display_lines, { raw => 1 });
            print "\n\n"; # One to add space, one to clear readline artifacts
            $answer = prompt('Edit what? (q to quit)');
         } while ( $answer ne 'q' );

         return $col;
      },
   },
   j => {
      note => 'Move highlight down one',
      func => sub {
         my ( $tbl, $col ) = @_;
         my @visible_cols = @{ $tbl_meta{$tbl}->{visible} };
         my $idx          = 0;
         while ( $visible_cols[$idx] ne $col ) {
            $idx++;
         }
         return $visible_cols[ ($idx + 1) % @visible_cols ];
      },
   },
   k => {
      note => 'Move highlight up one',
      func => sub {
         my ( $tbl, $col ) = @_;
         my @visible_cols = @{ $tbl_meta{$tbl}->{visible} };
         my $idx          = 0;
         while ( $visible_cols[$idx] ne $col ) {
            $idx++;
         }
         return $visible_cols[ $idx - 1 ];
      },
   },
   '+' => {
      note => 'Move selected column up one',
      func => sub {
         my ( $tbl, $col ) = @_;
         my $meta         = $tbl_meta{$tbl};
         my @visible_cols = @{$meta->{visible}};
         my $idx          = 0;
         while ( $visible_cols[$idx] ne $col ) {
            $idx++;
         }
         if ( $idx ) {
            $visible_cols[$idx]     = $visible_cols[$idx - 1];
            $visible_cols[$idx - 1] = $col;
            $meta->{visible}        = \@visible_cols;
         }
         else {
            shift @{$meta->{visible}};
            push @{$meta->{visible}}, $col;
         }
         return $col;
      },
   },
   '-' => {
      note => 'Move selected column down one',
      func => sub {
         my ( $tbl, $col ) = @_;
         my $meta         = $tbl_meta{$tbl};
         my @visible_cols = @{$meta->{visible}};
         my $idx          = 0;
         while ( $visible_cols[$idx] ne $col ) {
            $idx++;
         }
         if ( $idx == $#visible_cols ) {
            unshift @{$meta->{visible}}, $col;
            pop @{$meta->{visible}};
         }
         else {
            $visible_cols[$idx]     = $visible_cols[$idx + 1];
            $visible_cols[$idx + 1] = $col;
            $meta->{visible}        = \@visible_cols;
         }
         return $col;
      },
   },
   o => {
      note => 'Edit table meta-data (sort column, filters...)',
      func => sub {
         my ( $tbl, $col ) = @_;
         $clear_screen_sub->();
         my $meta         = $tbl_meta{$tbl};
         my $sort_cols    = $meta->{sort_cols};
         my $filters      = $meta->{filters};
         my @prop         = qw(filters sort_cols);

         my $answer;
         do {
            # Do whatever the user asked
            if ( $answer && grep { $_ eq $answer } @prop ) {
               my $ini = ref $meta->{$answer} ? join(' ', @{$meta->{$answer}}) : $meta->{$answer};
               if ( $answer eq 'sort_cols' ) {
                  choose_sort_cols($tbl);
               }
               elsif ( $answer eq 'filters' ) {
                  $clear_screen_sub->();
                  my $val = prompt_list(
                     'Choose filters',
                     $ini,
                     sub { return keys %filters },
                     {
                        map  { $_ => $filters{$_}->{note} }
                        grep { grep { $tbl eq $_ } @{$filters{$_}->{tbls}} }
                        keys %filters
                     }
                  );

                  my @choices = unique(split(/\s+/, $val));
                  foreach my $new ( grep { !exists($filters{$_}) } @choices ) {
                     my $answer = prompt("There is no filter called '$new'.  Create it?", undef, 'y');
                     if ( $answer eq 'y' ) {
                        create_new_filter($new, $tbl);
                     }
                  }
                  @choices = grep { exists $filters{$_} } @choices;
                  @choices = grep { grep { $tbl eq $_ } @{$filters{$_}->{tbls}} } @choices;
                  $meta->{filters} = [ @choices ];
               }
            }

            my @display_lines = "You are editing table $tbl.";

            push @display_lines, '', create_caption('Properties', create_table2(
               \@prop,
               { map { $_ => $_ } @prop },
               { map { $_ => ref $meta->{$_} eq 'ARRAY' ? join(' ', @{$meta->{$_}})
                           :                              $meta->{$_}
                     } @prop
               },
               { sep => '  ' }));
            draw_screen(\@display_lines, { raw => 1 });
            print "\n\n"; # One to add space, one to clear readline artifacts
            $answer = prompt('Edit what? (q to quit)', undef, undef, sub { return @prop });
         } while ( $answer ne 'q' );

         return $col;
      },
   },
);

# ###########################################################################
# Global variables and environment {{{2
# ###########################################################################

# Set up required stuff for interactive mode...
if ( !$opts{n} ) {
   require Term::ReadKey;
   import Term::ReadKey qw(ReadMode ReadKey);
}

my @this_term_size; # w_chars, h_chars, w_pix, h_pix
my @last_term_size; # w_chars, h_chars, w_pix, h_pix
my $char;
my $windows       = $OSNAME =~ m/Win/i;
my $have_color    = 0;
my $MAX_ULONG     = 4294967295; # 2^32-1
my $num_regex     = qr/^[+-]?(?=\d|\.)\d*(?:\.\d+)?(?:E[+-]?\d+|)$/i;
my $term          = undef;

if ( !$opts{n} ) {
   require Term::ReadLine;
   $term = Term::ReadLine->new('innotop');
}

# Stores status, variables, innodb status, master/slave status etc.
# Keyed on connection name.  Each entry is a hashref of current and past data sets,
# keyed on clock tick.
my %vars;
my %info_gotten = (); # Which things have been retrieved for the current clock tick.

# Stores info on currently displayed queries: cxn, connection ID, query text.
my @current_queries;

my $hi_res              = 0;
my $lines_printed       = 0;
my @innodb_files        = ();
my $innodb_file_counter = -1;
my $clock               = 0;   # Incremented with every wake-sleep cycle
my $clearing_deadlocks  = 0;

# If hi-res time is available, use it.
eval {
   require Time::HiRes;
   import Time::HiRes qw(time sleep);
   $hi_res   = 1;
};

# Find the home directory; it's different on different OSes.
my $homepath = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';

# If terminal coloring is available, use it.  The only function I want from
# the module is the colored() function.
eval {
   if ( !$opts{n} ) {
      if ( $windows ) {
         require Win32::Console::ANSI;
      }
      require Term::ANSIColor;
      import Term::ANSIColor qw(colored);
      $have_color = 1;
   }
};
if ( $EVAL_ERROR ) {
   # If there was an error, manufacture my own colored() function that does no
   # coloring.
   *colored = sub { return shift; };
}

if ( $opts{n} ) {
   $clear_screen_sub = sub {};
}
elsif ( $windows ) {
   $clear_screen_sub = sub { $lines_printed = 0; system("cls") };
}
else {
   my $clear = `clear`;
   $clear_screen_sub = sub { $lines_printed = 0; print $clear };
}

# ###########################################################################
# Config storage. {{{2
# ###########################################################################
my %config = (
   show_cxn_errors_in_tbl => {
      val  => 1,
      note => 'Whether to display connection errors at the end of every table',
      conf => [ 'ALL' ],
      pat  => qr/^[01]$/,
   },
   show_cxn_errors => {
      val  => 1,
      note => 'Whether to print connection errors to STDOUT',
      conf => [ 'ALL' ],
      pat  => qr/^[01]$/,
   },
   readonly => {
      val  => 0,
      note => 'Whether the config file is read-only',
      conf => [ qw() ],
      pat  => qr/^[01]$/,
   },
   global => {
      val  => 1,
      note => 'Whether to show GLOBAL variables and status',
      conf => 'ALL',
      pat  => qr/^[01]$/,
   },
   header_highlight => {
      val  => 'bold',
      note => 'How to highlight table column headers',
      conf => 'ALL',
      pat  => qr/^(?:bold|underline)$/,
   },
   display_table_captions => {
      val  => 1,
      note => 'Whether to put captions on tables',
      conf => 'ALL',
      pat  => qr/^[01]$/,
   },
   compact_hdr => {
      val  => 1,
      note => 'Whether to compact the headers in some modes',
      conf => 'ALL',
      pat  => qr/^[01]$/,
   },
   charset => {
      val  => 'ascii',
      note => 'What type of characters should be displayed in queries (ascii, unicode, none)',
      conf => 'ALL',
      pat  => qr/^(?:ascii|unicode|none)$/,
   },
   auto_wipe_dl => {
      val  => 0,
      note => 'Whether to auto-wipe InnoDB deadlocks',
      conf => 'ALL',
      pat  => qr/^[01]$/,
   },
   max_height => {
      val  => 30,
      note => '[Win32] Max window height',
      conf => 'ALL',
   },
   debug => {
      val  => 0,
      pat  => qr/^[01]$/,
      note => 'Debug mode (more verbose errors, uses more memory)',
      conf => [ qw(D) ],
   },
   num_digits => {
      val  => 2,
      pat  => qr/^\d$/,
      note => 'How many digits to show in fractional numbers and percents',
      conf => 'ALL',
   },
   show_QT_header => {
      val  => 1,
      pat  => qr/^[01]$/,
      note => 'Whether to show the header in Q and T modes',
      conf => [ qw(Q T) ],
   },
   debugfile => {
      val  => "$homepath/.innotop_core_dump",
      note => 'A debug file in case you are interested in error output',
   },
   show_statusbar => {
      val  => 1,
      pat  => qr/^[01]$/,
      note => 'Whether to show the status bar in the display',
      conf => 'ALL',
   },
   mode => {
      val  => "T",
      note => "Which mode to start in",
      cmdline => 1,
   },
   status_inc => {
      val  => 0,
      note => 'Whether to show raw or incremental values for status variables',
      pat  => qr/^[01]$/,
   },
   interval => {
      val  => 10,
      pat  => qr/^(?:(?:\d*?[1-9]\d*(?:\.\d*)?)|(?:\d*\.\d*?[1-9]\d*))$/,
      note => "The interval at which the display will be refreshed.  Fractional values allowed.",
   },
   V_set => {
      val  => 'general',
      pat  => qr/^\w+$/,
      note => 'Which set of variables to display in V (Variables/Status) mode',
      conf => [ qw(V) ],
   },
   num_status_sets => {
      val  => 9,
      pat  => qr/^\d*?[1-9]\d*$/,
      note => 'How many sets of STATUS and VARIABLES values to show',
      conf => [ qw(V) ],
   },
   G_set => {
      val  => 'general',
      pat  => qr/^\w+$/,
      note => 'Which set of variables to display in G (Load Graph) mode',
      conf => [ qw(G) ],
   },
   S_set => {
      val  => 'general',
      pat  => qr/^\w+$/,
      note => 'Which set of variables to display in S (Load Statistics) mode',
      conf => [ qw(S) ],
   },
);

# ###########################################################################
# Config file sections {{{2
# The configuration file is broken up into sections like a .ini file.  This
# variable defines those sections and the subroutines responsible for reading
# and writing them.
# ###########################################################################
my %config_file_sections = (
   filters => {
      reader => \&load_config_filters,
      writer => \&save_config_filters,
   },
   active_filters => {
      reader => \&load_config_active_filters,
      writer => \&save_config_active_filters,
   },
   visible_tables => {
      reader => \&load_config_visible_tables,
      writer => \&save_config_visible_tables,
   },
   sort_cols => {
      reader => \&load_config_sort_cols,
      writer => \&save_config_sort_cols,
   },
   active_columns => {
      reader => \&load_config_active_columns,
      writer => \&save_config_active_columns,
   },
   expressions => {
      reader => \&load_config_expressions,
      writer => \&save_config_expressions,
   },
   tbl_meta => {
      reader => \&load_config_tbl_meta,
      writer => \&save_config_tbl_meta,
   },
   general => {
      reader => \&load_config_config,
      writer => \&save_config_config,
   },
   connections => {
      reader => \&load_config_connections,
      writer => \&save_config_connections,
   },
   active_connections => {
      reader => \&load_config_active_connections,
      writer => \&save_config_active_connections,
   },
   server_groups => {
      reader => \&load_config_server_groups,
      writer => \&save_config_server_groups,
   },
   active_server_groups => {
      reader => \&load_config_active_server_groups,
      writer => \&save_config_active_server_groups,
   },
   max_values_seen => {
      reader => \&load_config_mvs,
      writer => \&save_config_mvs,
   },
   varsets => {
      reader => \&load_config_varsets,
      writer => \&save_config_varsets,
   },
   colors => {
      reader => \&load_config_colors,
      writer => \&save_config_colors,
   },
);

# Config file sections have some dependencies, so they have to be read/written in order.
my @ordered_config_file_sections = qw(filters active_filters expressions tbl_meta
   general connections active_connections server_groups active_server_groups max_values_seen
   active_columns sort_cols visible_tables varsets colors);

# ###########################################################################
# Contains logic to generate prepared statements for a given function for a
# given DB connection.  $cxn is a key in %dbhs.  Returns a SQL string.
# ###########################################################################
my %stmt_maker_for = (
   INNODB_STATUS => sub {
      my ( $cxn ) = @_;
      my $meta = $dbhs{$cxn};
      return ( $meta->{ver_major} >= 5 )
             ? 'SHOW ENGINE INNODB STATUS'
             : 'SHOW INNODB STATUS';
   },
   SHOW_VARIABLES => sub {
      my ( $cxn ) = @_;
      my $meta = $dbhs{$cxn};
      return ( $config{global}->{val} && $meta->{ver_major} >= 4 ) && ( $meta->{ver_rev} >= 3 )
             ? 'SHOW GLOBAL VARIABLES'
             : 'SHOW VARIABLES';
   },
   SHOW_STATUS => sub {
      my ( $cxn ) = @_;
      my $meta = $dbhs{$cxn};
      return ( $config{global}->{val} && $meta->{ver_major} >= 5 ) && ( $meta->{ver_rev} >= 2 )
             ? 'SHOW GLOBAL STATUS'
             : 'SHOW STATUS';
   },
   KILL_QUERY => sub {
      my ( $cxn ) = @_;
      my $meta = $dbhs{$cxn};
      return ( $meta->{ver_major} >= 5 )
             ? 'KILL QUERY ?'
             : 'KILL ?';
   },
   SHOW_MASTER_STATUS => sub {
      my ( $cxn ) = @_;
      return 'SHOW MASTER STATUS';
   },
   SHOW_SLAVE_STATUS => sub {
      my ( $cxn ) = @_;
      return 'SHOW SLAVE STATUS';
   },
   KILL_CONNECTION => sub {
      my ( $cxn ) = @_;
      return 'KILL CONNECTION ?';
   },
   OPEN_TABLES => sub {
      my ( $cxn ) = @_;
      return 'SHOW OPEN TABLES';
   },
   PROCESSLIST => sub {
      my ( $cxn ) = @_;
      return 'SHOW FULL PROCESSLIST';
   },
);

# ###########################################################################
# Run the program {{{1
# ###########################################################################

# This config variable is only useful for MS Windows because its terminal
# can't tell how tall it is.
if ( !$windows ) {
   delete $config{max_height};
}

# Try to lower my priority.
eval { setpriority(0, 0, getpriority(0, 0) + 10); };

# Print stuff to the screen immediately, don't wait for a newline.
$OUTPUT_AUTOFLUSH = 1;

# Clear the screen and load the configuration.
$clear_screen_sub->();
load_config();
post_process_tbl_meta();

# Make sure no changes are written to config file in non-interactive mode.
if ( $opts{n} ) {
   $config{readonly}->{val} = 1;
}

eval {
   while (++$clock) {

      my $mode = $config{mode}->{val};

      if ( !$opts{n} ) {
         @last_term_size = @this_term_size;
         @this_term_size = Term::ReadKey::GetTerminalSize(\*STDOUT);
         if ( $windows ) {
            $this_term_size[0]--;
            $this_term_size[1]
               = min($this_term_size[1], $config{max_height}->{val});
         }
         die("Can't read terminal size") unless @this_term_size;
      }

      # If there's no connection to a database server, we need to fix that...
      if ( !%connections ) {
         print "You have not defined any database connections.\n\n";
         add_new_dsn();
      }

      # See whether there are any connections defined for this mode.  If there's only one
      # connection total, assume the user wants to just use innotop for a single server
      # and don't ask which server to connect to.
      if ( !get_connections() ) {
         if ( 1 == scalar keys %connections ) {
            $modes{$config{mode}->{val}}->{connections} = [ keys %connections ];
         }
         else {
            choose_connections();
         }
      }

      # Term::ReadLine might have re-set $OUTPUT_AUTOFLUSH.
      $OUTPUT_AUTOFLUSH = 1;

      # Prune old data
      my $sets = $config{num_status_sets}->{val};
      foreach my $store ( values %vars ) {
         delete @{$store}{ grep { $_ < $clock - $sets } keys %$store };
      }
      %info_gotten = ();

      # Call the subroutine to display this mode.
      $modes{$mode}->{display_sub}->();

      # Wait for a bit.
      if ( $opts{n} ) {
         sleep($config{interval}->{val});
      }
      else {
         ReadMode('cbreak');
         $char = ReadKey($config{interval}->{val});
         ReadMode('normal');
      }

      # Handle whatever action the key indicates.
      do_key_action();

   }
};
if ( $EVAL_ERROR ) {
   core_dump( $EVAL_ERROR );
}
finish();

# Subroutines {{{1
# Mode functions{{{2
# switch_mode {{{3
sub switch_mode {
   my $mode = shift;
   $config{mode}->{val} = $mode;
}

# Prompting functions {{{2
# prompt_list {{{3
# Prompts the user for a value, given a question, initial value,
# a completion function and a hashref of hints.
sub prompt_list {
   die "Can't call in non-interactive mode" if $opts{n};
   my ( $question, $init, $completion, $hints ) = @_;
   if ( $hints ) {
      # Figure out how wide the table will be
      my $max_name = max(map { length($_) } keys %$hints );
      $max_name ||= 0;
      $max_name +=  3;
      my @meta_rows = create_table2(
               [ sort keys %$hints ],
               { map { $_ => $_ } keys %$hints },
               { map { $_ => trunc($hints->{$_}, $this_term_size[0] - $max_name) } keys %$hints },
               { sep => '  ' });
      if (@meta_rows > 10) {
         # Try to split and stack the meta rows next to each other
         my $split = int(@meta_rows / 2);
         @meta_rows = stack_next(
            [@meta_rows[0..$split - 1]],
            [@meta_rows[$split..$#meta_rows]],
            { pad => ' | '},
         );
      }
      print join( "\n",
         '',
         map { ref $_ ? colored(@$_) : $_ } create_caption('Choose from', @meta_rows), ''),
         "\n";
   }
   $term->Attribs->{completion_function} = $completion;
   my $answer = $term->readline("$question: ", $init);
   $OUTPUT_AUTOFLUSH = 1;
   $answer = '' if !defined($answer);
   $answer =~ s/\s+$//;
   return $answer;
}

# prompt {{{3
# Prints out a prompt and reads from the keyboard, then validates with the
# validation regex until the input is correct.
sub prompt {
   die "Can't call in non-interactive mode" if $opts{n};
   my ( $prompt, $regex, $init, $completion ) = @_;
   my $response;
   my $success = 0;
   do {
      if ( $completion ) {
         $term->Attribs->{completion_function} = $completion;
      }
      $response = $term->readline("$prompt: ", $init);
      if ( $regex && $response !~ m/$regex/ ) {
         print "Invalid response.\n\n";
      }
      else {
         $success = 1;
      }
   } while ( !$success );
   $OUTPUT_AUTOFLUSH = 1;
   $response =~ s/\s+$//;
   return $response;
}

# prompt_noecho {{{3
# Unfortunately, suppressing echo with Term::ReadLine isn't reliable; the user might not
# have that library, or it might not support that feature.
sub prompt_noecho {
   my ( $prompt ) = @_;
   print colored("$prompt: ", 'underline');
   my $response;
   ReadMode('noecho');
   $response = <STDIN>;
   chomp($response);
   ReadMode('normal');
   return $response;
}

# do_key_action {{{3
# Depending on whether a key was read, do something.  Keys have certain
# actions defined in lookup tables.  Each mode may have its own lookup table,
# which trumps the global table -- so keys can be context-sensitive.  The key
# may be read and written in a subroutine, so it's a global.
sub do_key_action {
   if ( defined $char ) {
      my $mode = $config{mode}->{val};
      my $action
         = defined($modes{$mode}->{action_for}->{$char})
         ? $modes{$mode}->{action_for}->{$char}->{action}
         : defined($action_for{$char})
         ? $action_for{$char}->{action}
         : sub{};
      $action->();
   }
}

# pause {{{3
sub pause {
   die "Can't call in non-interactive mode" if $opts{n};
   my $msg = shift;
   print defined($msg) ? "\n$msg" : "\nPress any key to continue";
   ReadMode('cbreak');
   my $char = ReadKey(0);
   ReadMode('normal');
   return $char;
}

# reverse_sort {{{3
sub reverse_sort {
   my $tbl = shift;
   $tbl_meta{$tbl}->{sort_dir} *= -1;
}

# select_cxn {{{3
# Selects connection(s).  If the mode (or argument list) has only one, returns
# it without prompt.
sub select_cxn {
   my ( $prompt, @cxns ) = @_;
   if ( !@cxns ) {
      @cxns = get_connections();
   }
   if ( @cxns == 1 ) {
      return $cxns[0];
   }
   my $choices = prompt_list(
         $prompt,
         $cxns[0],
         sub{ return @cxns },
         { map { $_ => $connections{$_}->{dsn} } @cxns });
   my @result = unique(grep { my $a = $_; grep { $_ eq $a } @cxns } split(/\s+/, $choices));
   return @result;
}

# kill_query {{{3
# Kills a connection, or on new versions, optionally a query but not connection.
sub kill_query {
   my ( $q_or_c ) = @_;

   my ( $cxn ) = select_cxn('Kill on which server');
   return unless $cxn && exists($connections{$cxn});

   eval {
      my $thread = prompt("Choose which $q_or_c to kill");
      return unless $thread && $thread =~ m/^\d+$/;
      do_stmt($cxn, $q_or_c eq 'QUERY' ? 'KILL_QUERY' : 'KILL_CONNECTION', $thread);
   };

   if ( $EVAL_ERROR ) {
      print "\nError: $EVAL_ERROR";
      pause();
   }
}

# set_V_set {{{3
sub set_V_set {
   $config{V_set}->{val} = shift;
}

# set_display_precision {{{3
sub set_display_precision {
   my $dir = shift;
   $config{num_digits}->{val} = min(9, max(0, $config{num_digits}->{val} + $dir));
}

# toggle_filter{{{3
sub toggle_filter {
   my ( $tbl, $filter ) = @_;
   my $filters = $tbl_meta{$tbl}->{filters};
   if ( grep { $_ eq $filter } @$filters ) {
      $tbl_meta{$tbl}->{filters} = [ grep { $_ ne $filter } @$filters ];
   }
   else {
      push @$filters, $filter;
   }
}

# toggle_config {{{3
sub toggle_config {
   my ( $key ) = @_;
   $config{$key}->{val} ^= 1;
}

# create_deadlock {{{3
sub create_deadlock {
   $clear_screen_sub->();

   print "This function will deliberately cause a small deadlock, "
      . "clearing deadlock information from the InnoDB monitor.\n\n";

   my $answer = prompt("Are you sure you want to proceed?  Say 'y' if you do");
   return 0 unless $answer eq 'y';

   my ( $cxn ) = select_cxn('Clear on which server? ');
   return unless $cxn && exists($connections{$cxn});

   clear_deadlock($cxn);
}

# deadlock_thread {{{3
sub deadlock_thread {
   my ( $id, $tbl, $cxn ) = @_;
   my @stmts = (
      "set transaction isolation level serializable",
      "start transaction",
      "select * from $tbl where a = $id",
      "update $tbl set a = $id where a <> $id",
   );

   eval {
      my $dbh = get_new_db_connection($cxn, 1);
      foreach my $stmt (@stmts[0..2]) {
         $dbh->do($stmt);
      }
      sleep(1 + $id);
      $dbh->do($stmts[-1]);
   };
   if ( $EVAL_ERROR ) {
      if ( $EVAL_ERROR !~ m/Deadlock found/ ) {
         die $EVAL_ERROR;
      }
   }
   exit(0);
}

sub send_cmd_to_servers {
   my ( $cmd, $all, $hint ) = @_;
   my @cxns;
   if ( $all ) {
      @cxns = get_connections();
   }
   @cxns = select_cxn('Which servers?', @cxns);
   if ( $hint ) {
      print "\nHint: $hint\n";
   }
   $cmd = prompt('Command to send', undef, $cmd);
   foreach my $cxn ( @cxns ) {
      eval {
         my $sth = do_query($cxn, $cmd);
      };
      if ( $EVAL_ERROR ) {
         print "Error from $cxn: $EVAL_ERROR\n";
      }
      else {
         print "Success on $cxn\n";
      }
   }
   pause();
}

# Display functions {{{2

# start_G_mode {{{3
sub start_G_mode {
   $clear_screen_sub->();
   switch_mode('G');
}

# start_S_mode {{{3
sub start_S_mode {
   $clear_screen_sub->();
   switch_mode('S');
}

# display_B {{{3
sub display_B {
   my @display_lines;
   my @cxns = get_connections();
   get_innodb_status(\@cxns);

   my @buffer_pool;
   my @page_statistics;
   my @insert_buffers;
   my @adaptive_hash_index;
   my %rows_for = (
      buffer_pool         => \@buffer_pool,
      page_statistics     => \@page_statistics,
      insert_buffers      => \@insert_buffers,
      adaptive_hash_index => \@adaptive_hash_index,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   foreach my $cxn ( @cxns ) {
      my $set = $vars{$cxn}->{$clock};

      if ( $set->{IB_bp_complete} ) {
         if ( $wanted{buffer_pool} ) {
            push @buffer_pool, extract_values($set, 'buffer_pool');
         }
         if ( $wanted{page_statistics} ) {
            push @page_statistics, extract_values($set, 'page_statistics');
         }
      }
      if ( $set->{IB_ib_complete} ) {
         if ( $wanted{insert_buffers} ) {
            push @insert_buffers, extract_values(
               $config{status_inc}->{val} ? inc(0, $cxn) : $set,
               'insert_buffers');
         }
         if ( $wanted{adaptive_hash_index} ) {
            push @adaptive_hash_index, extract_values($set, 'adaptive_hash_index');
         }
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;;
   }

   draw_screen(\@display_lines);
}

# display_D {{{3
sub display_D {
   my @display_lines;
   my @cxns = get_connections();
   get_innodb_status(\@cxns);

   my @deadlock_transactions;
   my @deadlock_locks;
   my %rows_for = (
      deadlock_transactions => \@deadlock_transactions,
      deadlock_locks        => \@deadlock_locks,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   foreach my $cxn ( @cxns ) {
      my $innodb_status = $vars{$cxn}->{$clock};

      if ( $innodb_status->{IB_dl_timestring} ) {

         my $victim = $innodb_status->{IB_dl_rolled_back} || 0;

         if ( %wanted ) {
            foreach my $txn_id ( keys %{$innodb_status->{IB_dl_txns}} ) {
               my $txn = $innodb_status->{IB_dl_txns}->{$txn_id};

               if ( $wanted{deadlock_transactions} ) {
                  my $hash = extract_values($txn->{tx}, 'deadlock_transactions');
                  $hash->{cxn}        = $cxn;
                  $hash->{dl_txn_num} = $txn_id;
                  $hash->{victim}     = $txn_id == $victim ? 'Yes' : 'No';
                  $hash->{timestring} = $innodb_status->{IB_dl_timestring};
                  $hash->{truncates}  = $innodb_status->{IB_dl_complete} ? 'No' : 'Yes';
                  push @deadlock_transactions, $hash;
               }

               if ( $wanted{deadlock_locks} ) {
                  foreach my $what (qw(waits_for holds)) {
                     my $locks = $txn->{$what};
                     if ( $locks ) {
                        my $hash = extract_values($locks, 'deadlock_locks');
                        $hash->{dl_txn_num}      = $txn_id;
                        $hash->{txn_status}      = $what;
                        $hash->{cxn}             = $cxn;
                        $hash->{mysql_thread_id} = $txn->{tx}->{mysql_thread_id};
                        push @deadlock_locks, $hash;
                     }
                  }
               }

            }
         }
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;;
   }

   draw_screen(\@display_lines);
}

# display_F {{{3
sub display_F {
   my @display_lines;
   my ( $cxn ) = get_connections();
   get_innodb_status([$cxn]);
   my $innodb_status = $vars{$cxn}->{$clock};

   if ( $innodb_status->{IB_fk_timestring} ) {

      push @display_lines, 'Reason: ' . $innodb_status->{IB_fk_reason};

      # Display FK errors caused by invalid DML.
      if ( $innodb_status->{IB_fk_txn} ) {
         my $txn = $innodb_status->{IB_fk_txn};
         push @display_lines,
            '',
            "User $txn->{user} from $txn->{hostname}, thread $txn->{mysql_thread_id} was executing:",
            '', no_ctrl_char($txn->{query_text});
      }

      my @fk_table = create_table2(
         $tbl_meta{fk_error}->{visible},
         meta_to_hdr('fk_error'),
         extract_values($innodb_status, 'fk_error'),
         { just => '-', sep => '  '});
      push @display_lines, '', @fk_table;

   }
   else {
      push @display_lines, '', 'No foreign key error data.';
   }
   draw_screen(\@display_lines, { raw => 1 } );
}

# display_G {{{3
sub display_G {
   my ( $cxn ) = get_connections();
   my $fmt     = get_var_set('G_set');
   get_status_info($cxn);
   get_innodb_status([$cxn]); # TODO: might not be needed.

   if ( !exists $vars{$cxn}->{$clock - 1} ) {
      return;
   }

   # Design a column format for the values.
   my $num_cols = scalar(@$fmt);
   my $width    = $opts{n} ? 0 : int(($this_term_size[0] - $num_cols + 1) / $num_cols);
   my $format   = $opts{n} ? ( "%s\t" x $num_cols ) : ( "%-${width}s " x $num_cols );
   $format      =~ s/\s$/\n/;

   # Clear the screen if the display width changed.
   if ( @last_term_size && $this_term_size[0] != $last_term_size[0] ) {
      $lines_printed = 0;
      $clear_screen_sub->();
   }

   # Get the values.
   my $set = inc(0, $cxn);
   $set = { map { $_ => ($set->{$_} || 1) / ( $set->{Uptime_hires} || 1) } @$fmt };

   # Update max ever seen.
   map { $mvs{$_} = max($mvs{$_} || 1, $set->{$_}) } @$fmt;

   # Print headers every now and then.
   if ( $opts{n} ) {
      if ( $lines_printed == 0 ) {
         print join("\t", @$fmt), "\n";
         print join("\t", map { shorten($mvs{$_}) } @$fmt), "\n";
      }
   }
   elsif ( $lines_printed % int( $this_term_size[1] - 2 ) == 0 ) {
      printf($format, map { donut(crunch($_, $width), $width) } @$fmt);
      printf($format, map { shorten($mvs{$_}) } @$fmt);
   }
   $lines_printed++;

   # Scale the values against the max ever seen.
   map { $set->{$_} /= $mvs{$_} } @$fmt;

   # Print the values.
   printf($format, map { ( '*' x int( $width * $set->{$_} )) || '.' } @$fmt );
}

# display_I {{{3
sub display_I {
   my @display_lines;
   my @cxns = get_connections();
   get_innodb_status(\@cxns);

   my @io_threads;
   my @pending_io;
   my @file_io_misc;
   my @log_statistics;
   my %rows_for = (
      io_threads     => \@io_threads,
      pending_io     => \@pending_io,
      file_io_misc   => \@file_io_misc,
      log_statistics => \@log_statistics,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   foreach my $cxn ( @cxns ) {
      my $set = $vars{$cxn}->{$clock};

      if ( $set->{IB_io_complete} ) {
         if ( $wanted{io_threads} ) {
            foreach my $thd ( values %{$set->{IB_io_threads}} ) {
               my $hash = extract_values($thd, 'io_threads');
               $hash->{cxn} = $cxn;
               push @io_threads, $hash;
            }
         }
         if ( $wanted{pending_io} ) {
            push @pending_io, extract_values($set, 'pending_io');
         }
         if ( $wanted{file_io_misc} ) {
            push @file_io_misc, extract_values(
               $config{status_inc}->{val} ? inc(0, $cxn) : $set,
               'file_io_misc');
         }
      }
      if ( $set->{IB_lg_complete} && $wanted{log_statistics} ) {
         push @log_statistics, extract_values($set, 'log_statistics');
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;;
   }

   draw_screen(\@display_lines);
}

# display_M {{{3
sub display_M {
   my @display_lines;
   my @cxns = get_connections();
   get_master_slave_status(@cxns);
   get_status_info(@cxns);

   my @slave_sql_status;
   my @slave_io_status;
   my @master_status;
   my %rows_for = (
      slave_sql_status => \@slave_sql_status,
      slave_io_status  => \@slave_io_status,
      master_status    => \@master_status,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   foreach my $cxn ( @cxns ) {
      my $set  = $config{status_inc}->{val} ? inc(0, $cxn) : $vars{$cxn}->{$clock};
      if ( $wanted{slave_sql_status} ) {
         push @slave_sql_status, extract_values($set, 'slave_sql_status');
      }
      if ( $wanted{slave_io_status} ) {
         push @slave_io_status, extract_values($set, 'slave_io_status');
      }
      if ( $wanted{master_status} ) {
         push @master_status, extract_values($set, 'master_status');
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;;
   }

   draw_screen(\@display_lines);
}

# display_O {{{3
sub display_O {
   my @display_lines = ('');
   my @cxns          = get_connections();
   my @open_tables   = get_open_tables(@cxns);
   my @tables = map { extract_values($_, 'open_tables') } @open_tables;
   push @display_lines, set_to_tbl(\@tables, 'open_tables'), get_cxn_errors(@cxns);
   draw_screen(\@display_lines);
}

# display_Q {{{3
sub display_Q {
   my @display_lines;

   my @q_header;
   my @processlist;
   my %rows_for = (
      q_header    => \@q_header,
      processlist => \@processlist,
   );

   my @visible = $opts{n} ? 'processlist' : get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   # Config variable overrides %wanted here. TODO: this is hack-ish.
   $wanted{q_header} = $config{show_QT_header}->{val};

   # Get the data
   my @cxns             = get_connections();
   my @full_processlist = get_full_processlist(@cxns);

   # Create header
   if ( $wanted{q_header} ) {
      get_status_info(@cxns);
      foreach my $cxn ( @cxns ) {
         my $hash = extract_values($vars{$cxn}->{$clock}, 'q_header');
         $hash->{cxn} = $cxn;
         $hash->{when} = 'Total';
         push @q_header, $hash;

         if ( exists $vars{$cxn}->{$clock - 1} ) {
            my $inc = inc(0, $cxn);
            my $hash = extract_values($inc, 'q_header');
            $hash->{cxn} = $cxn;
            $hash->{when} = 'Now';
            push @q_header, $hash;
         }
      }
   }

   if ( $wanted{processlist} ) {
      push @processlist, map { extract_values($_, 'processlist') } @full_processlist;
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      next unless $wanted{$tbl};
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;
   }

   # Save queries in global variable for analysis.  The rows in %rows_for have been
   # filtered, etc as a side effect of set_to_tbl(), so they are the same as the rows
   # that get pushed to the screen.
   @current_queries = map {
      my %hash;
      @hash{ qw(cxn id db query) } = @{$_}{ qw(cxn mysql_thread_id db info) };
      \%hash;
   } @{$rows_for{processlist}};

   draw_screen(\@display_lines);
}

# display_R {{{3
sub display_R {
   my @display_lines;
   my @cxns = get_connections();
   get_innodb_status(\@cxns);

   my @row_operations;
   my @row_operation_misc;
   my @semaphores;
   my @wait_array;
   my %rows_for = (
      row_operations     => \@row_operations,
      row_operation_misc => \@row_operation_misc,
      semaphores         => \@semaphores,
      wait_array         => \@wait_array,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;
   my $incvar  = $config{status_inc}->{val};

   foreach my $cxn ( @cxns ) {
      my $set = $vars{$cxn}->{$clock};
      my $inc; # Only assigned to if wanted

      if ( $set->{IB_ro_complete} ) {
         if ( $wanted{row_operations} ) {
            $inc ||= $incvar ? inc(0, $cxn) : $set;
            push @row_operations, extract_values($inc, 'row_operations');
         }
         if ( $wanted{row_operation_misc} ) {
            push @row_operation_misc, extract_values($set, 'row_operation_misc'),
         }
      }

      if ( $set->{IB_sm_complete} && $wanted{semaphores} ) {
         $inc ||= $incvar ? inc(0, $cxn) : $set;
         push @semaphores, extract_values($inc, 'semaphores');
      }

      if ( $set->{IB_sm_wait_array_size} && $wanted{wait_array} ) {
         foreach my $wait ( @{$set->{IB_sm_waits}} ) {
            my $hash = extract_values($wait, 'wait_array');
            $hash->{cxn} = $cxn;
            push @wait_array, $hash;
         }
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;
   }

   draw_screen(\@display_lines);
}

# display_S {{{3
sub display_S {
   my $min_width = 4;
   my $inc       = $config{status_inc}->{val};
   my ( $cxn )   = get_connections();
   my $fmt       = get_var_set('S_set');
   get_status_info( $cxn );
   get_innodb_status([$cxn]); # TODO: might not be needed.

   # Clear the screen if the display width changed.
   if ( @last_term_size && $this_term_size[0] != $last_term_size[0] ) {
      $lines_printed = 0;
      $clear_screen_sub->();
   }

   # Decide how wide columns should be.
   my $num_cols = scalar(@$fmt);
   my $width    = $opts{n} ? 0 : max($min_width, int(($this_term_size[0] - $num_cols + 1) / $num_cols));

   # Print headers every now and then.  Headers can get really long, so compact them.
   my @hdr = @$fmt;
   if ( $opts{n} ) {
      if ( $lines_printed == 0 ) {
         print join("\t", @hdr), "\n";
      }
   }
   elsif ( $lines_printed % int( $this_term_size[1] - 2 ) == 0 ) {
      @hdr = map { donut(crunch($_, $width), $width) } @hdr;
      print join(' ', map { sprintf( "%${width}s", donut($_, $width)) } @hdr) . "\n";
   }

   # Design a column format for the values.
   my $format
      = $opts{n}
      ? join("\t", map { '%s' } @$fmt) . "\n"
      : join(' ',  map { "%${width}s" } @hdr) . "\n";

   # Print the values.
   my $set = $inc ? inc(0, $cxn) : $vars{$cxn}->{$clock};
   printf($format,
      map {
            exists $set->{$_} ? $set->{$_}
          : exists $exprs{$_} ? $exprs{$_}->{func}->($set)
          :                     0
      } @$fmt
   );
   $lines_printed++;
}

# display_T {{{3
sub display_T {
   my @display_lines;

   my @txns;
   my @cxns = get_connections();

   # If the header is to be shown, buffer pool data is required.
   my $hdr = ( !$opts{n} && 1 == scalar @cxns && $config{show_QT_header}->{val} );

   get_innodb_status( \@cxns, [ $hdr ? qw(bp) : () ] );

   foreach my $cxn ( get_connections() ) {
      my $set = $vars{$cxn}->{$clock};

      next unless $set->{IB_tx_transactions};

      if ( $set->{IB_tx_transactions} ) {
         foreach my $txn ( @{$set->{IB_tx_transactions}} ) {
            my $hash = extract_values($txn, 'innodb_transactions');
            $hash->{cxn} = $cxn;
            push @txns, $hash;
         }
      }

      if ( $hdr ) {
         push @display_lines, '', join(", ",
            "History: $set->{IB_tx_history_list_len}",
            "Versions: " . $exprs{OldVersions}->{func}->( $set ),
            "Undo: $set->{IB_tx_purge_undo_for}",
            "Dirty Bufs: " . percent($exprs{DirtyBufs}->{func}->( $set )) . '%',
            "Used Bufs: " . percent($exprs{BufPoolFill}->{func}->( $set )) . '%',
            "Max time: " . secs_to_time($exprs{MaxTxnTime}->{func}->( $set )),
            "Lock structs: $set->{IB_tx_num_lock_structs}",
         );
      }
   }

   push @display_lines, '', set_to_tbl(\@txns, 'innodb_transactions'), get_cxn_errors(@cxns);

   draw_screen(\@display_lines);
}

# display_V {{{3
# TODO: when entering V mode, remove any non-contiguous stuff from %vars.
sub display_V {
   my @display_lines;
   my ( $cxn ) = get_connections();
   my $fmt     = get_var_set('V_set');
   my $inc     = $config{status_inc}->{val};
   my $num     = $config{num_status_sets}->{val};

   get_status_info($cxn);
   get_innodb_status([$cxn]); # TODO: might not be needed.

   # Figure out how many past sets have actually been kept.
   while ( !exists $vars{$cxn}->{$clock - $num} ) {
      $num--;
   }

   # Build a meta dataset that can be used for a type-1 table
   my $meta = { name => { hdr => 'Name', just => '-' } };
   foreach my $set ( 0 .. $num ) {
      $meta->{"set_$set"} = { hdr => "Set $set", just => '' };
   }

   # Loop through them and do a 'pivot table' transformation on them.  Instead of
   # sets becoming rows, sets must become columns, and variables become rows.
   my @rows = map { { name => $_ } } @$fmt;
   foreach my $set ( 0 .. $num ) {
      my $vars = $inc ? inc($set, $cxn) : $vars{$cxn}->{$clock - $set};
      foreach my $row ( 0.. @$fmt - 1 ) {
         my $name = $fmt->[$row];
         my $val = exists($vars->{$name}) ? $vars->{$name}
                 : exists($exprs{$name})  ? $exprs{$name}->{func}->($vars)
                 :                          0;
         $rows[$row]->{"set_$set"} = defined $val ? $val : 0;
      }
   }

   my @cols = 'name';
   foreach my $set ( 0 .. $num ) {
      push @cols, "set_$set";
   }

   push @display_lines, create_table( \@cols, $meta, \@rows);

   $clear_screen_sub->();

   draw_screen( \@display_lines );
}

# display_W {{{3
sub display_W {
   my @display_lines;
   my @cxns = get_connections();
   get_innodb_status(\@cxns);

   my @lock_waits;
   my @wait_array;
   my %rows_for = (
      lock_waits => \@lock_waits,
      wait_array => \@wait_array,
   );

   my @visible = get_visible_tables();
   my %wanted  = map { $_ => 1 } @visible;

   # Get info on lock waits and OS wait array
   foreach my $cxn ( @cxns ) {
      my $set = $vars{$cxn}->{$clock} or next;

      if ( $wanted{lock_waits} && @{$set->{IB_tx_transactions}} ) {

         my @txns = @{$set->{IB_tx_transactions}};
         foreach my $txn ( grep { $_->{lock_wait_status} } @txns ) {
            my %lock_wait = map { $_ => $txn->{$_} }
               qw(txn_id mysql_thread_id lock_wait_time active_secs);
            my $wait_locks = $txn->{wait_locks};
            map { $lock_wait{$_} = $wait_locks->{$_} }
               qw(lock_type space_id page_no n_bits index db table txn_id
                     lock_mode special insert_intention waiting num_locks);
            $lock_wait{cxn} = $cxn;
            push @lock_waits, extract_values(\%lock_wait, 'lock_waits');
         }
      }

      if ( $wanted{wait_array} && $set->{IB_sm_complete} ) {
         if ( $set->{IB_sm_wait_array_size} ) {
            foreach my $wait ( @{$set->{IB_sm_waits}} ) {
               my $hash = extract_values($wait, 'wait_array');
               $hash->{cxn} = $cxn;
               push @wait_array, $hash;
            }
         }
      }
   }

   my $first_table = 0;
   foreach my $tbl ( @visible ) {
      push @display_lines, '', set_to_tbl($rows_for{$tbl}, $tbl);
      push @display_lines, get_cxn_errors(@cxns) unless $config{debug}->{val} || $first_table++;;
   }

   draw_screen(\@display_lines);
}

# display_explain {{{3
sub display_explain {
   my $info = shift;
   my $cxn   = $info->{cxn};
   my $db    = $info->{db};
   my $meta  = $dbhs{$cxn};

   my ( $mods, $query ) = rewrite_for_explain($info->{query});

   my @display_lines;

   if ( $query ) {

      my $part
         = ( $meta->{ver_major} >= 5 && $meta->{ver_minor} >= 1 && $meta->{ver_rev} >= 5 )
         ? 'PARTITIONS'
         : '';
      $query = "EXPLAIN $part\n" . $query;

      eval {
         if ( $db ) {
            do_query($cxn, "use $db");
         }
         my $sth = do_query($cxn, $query);

         my $res;
         while ( $res = $sth->fetchrow_hashref() ) {
            map { $res->{$_} ||= '' } ( 'partitions', keys %$res);
            my @this_table = create_caption("Sub-Part $res->{id}",
               create_table2(
                  $tbl_meta{explain}->{visible},
                  meta_to_hdr('explain'),
                  extract_values($res, 'explain')));
            @display_lines = stack_next(\@display_lines, \@this_table, { pad => '  ', vsep => 2 });
         }
      };

      if ( $EVAL_ERROR ) {
         push @display_lines, '', "The query could not be explained: $EVAL_ERROR";
      }

   }
   else {
      push @display_lines, '', 'The query could not be explained.';
   }

   if ( $mods ) {
      push @display_lines, '', '[This query has been re-written to be explainable]';
   }

   unshift @display_lines, no_ctrl_char($query);
   draw_screen(\@display_lines, { raw => 1 } );
}

# rewrite_for_explain {{{3
# Some replace/create/insert...select can be rewritten easily.
sub rewrite_for_explain {
   my $query = shift;

   my $mods = 0;
   my $orig = $query;
   $mods += $query =~ s/^\s*(?:replace|insert).*?select/select/is;
   $mods += $query =~ s/^
      \s*create\s+(?:temporary\s+)?table
      \s+(?:\S+\s+)as\s+select/select/xis;
   $mods += $query =~ s/\s+on\s+duplicate\s+key\s+update.*$//is;
   return ( $mods, $query );
}

# show_optimized_query {{{3
sub show_optimized_query {
   my $info = shift;
   my $cxn   = $info->{cxn};
   my $db    = $info->{db};
   my $meta  = $dbhs{$cxn};

   my @display_lines;

   my ( $mods, $query ) = rewrite_for_explain($info->{query});

   if ( $mods ) {
      push @display_lines, '[This query has been re-written to be explainable]';
   }

   if ( $query ) {
      push @display_lines, no_ctrl_char($info->{query});

      eval {
         if ( $db ) {
            do_query($cxn, "use $db");
         }
         do_query( $cxn, 'EXPLAIN EXTENDED ' . $query ) or die "Can't explain query";
         my $sth = do_query($cxn, 'SHOW WARNINGS');
         my $res = $sth->fetchall_arrayref;

         if ( $res ) {
            foreach my $result ( @$res ) {
               push @display_lines, 'Note:', no_ctrl_char($result->[2]);
            }
         }
         else {
            push @display_lines, '', 'The query optimization could not be generated.';
         }
      };

      if ( $EVAL_ERROR ) {
         push @display_lines, '', "The optimization could not be generated: $EVAL_ERROR";
      }

   }
   else {
      push @display_lines, '', 'The query optimization could not be generated.';
   }

   draw_screen(\@display_lines, { raw => 1 } );
}

# display_help {{{3
sub display_help {
   my $mode = $config{mode}->{val};

   # Get globally mapped keys, then overwrite them with mode-specific ones.
   my %keys = map {
         my $key = $action_for{$_}->{key} || $_;
         $key => $action_for{$_}->{label}
      } keys %action_for;
   foreach my $key ( keys %{$modes{$mode}->{action_for}} ) {
      $keys{$key} = $modes{$mode}->{action_for}->{$key}->{label};
   }
   delete $keys{'?'};

   my @display_lines = ( '', 'The following keys are mapped in this mode:', '', );
   push @display_lines,  create_table2(
      [ sort keys %keys ],
      { map { $_ => $_ } keys %keys },
      \%keys,
      { sep => '    ' }
   );
   push @display_lines, '', 'Any other key refreshes the display.', '';
   $clear_screen_sub->();
   draw_screen(\@display_lines, { show_all => 1 } );
   pause();
}

# show_full_query {{{3
sub show_full_query {
   my $info = shift;
   my @display_lines = no_ctrl_char($info->{query});
   draw_screen(\@display_lines, { raw => 1 });
}

# Formatting functions {{{2

# create_grid {{{3
sub create_grid {
   my @vals = @_;
   my @result;

   # Slice and stack, baby.
   my $i = 0;
   while ($i < @vals) {
      # Do 5 at a time
      my $max_index = min( scalar(@vals), $i + 5 );
      my @slice = @vals[$i..$max_index - 1];
      my $max_width = max( map{ length($_) } @slice );
      @slice  = map { sprintf("%-${max_width}s", $_) } @slice;
      @result = stack_next(\@result, \@slice);
      $i += 5;
   }
   return @result;
}

# create_table2 {{{3
# Makes a two-column table, labels on left, data on right.
# Takes refs of @cols, %labels and %data, %user_prefs
sub create_table2 {
   my ( $cols, $labels, $data, $user_prefs ) = @_;
   my @rows;

   if ( @$cols && %$data ) {

      # Override defaults
      my $p = {
         just  => '',
         sep   => ':',
         just1 => '-',
      };
      if ( $user_prefs ) {
         map { $p->{$_} = $user_prefs->{$_} } keys %$user_prefs;
      }

      # Fix undef values
      map { $data->{$_} = '' unless defined $data->{$_} } @$cols;

      # Format the table
      my $max_l = max(map{ length($labels->{$_}) } @$cols);
      my $max_v = max(map{ length($data->{$_}) } @$cols);
      my $format    = "%$p->{just}${max_l}s$p->{sep} %$p->{just1}${max_v}s";
      foreach my $col ( @$cols ) {
         push @rows, sprintf($format, $labels->{$col}, $data->{$col});
      }
   }
   return @rows;
}

# stack_next {{{3
# Stacks one display section next to the other.  Accepts left-hand arrayref,
# right-hand arrayref, and options hashref.  Tries to stack as high as
# possible, so
# aaaaaa
# bbb
# can stack ccc next to the bbb.
# NOTE: this DOES modify its arguments, even though it returns a new array.
sub stack_next {
   my ( $left, $right, $user_prefs ) = @_;
   my @result;

   my $p = {
      pad   => ' ',
      vsep  => 0,
   };
   if ( $user_prefs ) {
      map { $p->{$_} = $user_prefs->{$_} } keys %$user_prefs;
   }

   # Find out how wide the LHS can be and still let the RHS fit next to it.
   my $pad   = $p->{pad};
   my $max_r = max( map { length($_) } @$right) || 0;
   my $max_l = $this_term_size[0] - $max_r - length($pad);

   # Find the minimum row on the LHS that the RHS will fit next to.
   my $i = scalar(@$left) - 1;
   while ( $i >= 0 && length($left->[$i]) <= $max_l ) {
      $i--;
   }
   $i++;
   my $offset = $i;

   if ( $i < scalar(@$left) ) {
      # Find the max width of the section of the LHS against which the RHS
      # will sit.
      my $max_i_in_common = min($i + scalar(@$right) - 1, scalar(@$left) - 1);
      my $max_width = max( map { length($_) } @{$left}[$i..$max_i_in_common]);

      # Append the RHS onto the LHS until one runs out.
      while ( $i < @$left && $i - $offset < @$right ) {
         my $format = "%-${max_width}s$pad%${max_r}s";
         $left->[$i] = sprintf($format, $left->[$i], $right->[$i - $offset]);
         $i++;
      }
      while ( $i - $offset < @$right ) {
         # There is more RHS to push on the end of the array
         push @$left,
            sprintf("%${max_width}s$pad%${max_r}s", ' ', $right->[$i - $offset]);
         $i++;
      }
      push @result, @$left;
   }
   else {
      # There is no room to put them side by side.  Add them below, with
      # a blank line above them if specified.
      push @result, @$left;
      push @result, (' ' x $this_term_size[0]) if $p->{vsep} && @$left;
      push @result, @$right;
   }
   return @result;
}

# create_caption {{{3
sub create_caption {
   my ( $caption, @rows ) = @_;
   if ( @rows ) {

      # Calculate the width of what will be displayed, so it can be centered
      # in that space.  When the thing is wider than the display, center the
      # caption in the display.
      my $width = min($this_term_size[0], max(map { length(ref($_) ? $_->[0] : $_) } @rows));

      my $cap_len = length($caption);

      # It may be narrow enough to pad the sides with underscores and save a
      # line on the screen.
      if ( $cap_len <= $width - 6 ) {
         my $left = int(($width - 2 - $cap_len) / 2);
         unshift @rows,
            ("_" x $left) . " $caption " . ("_" x ($width - $left - $cap_len - 2));
      }

      # The caption is too wide to add underscores on each side.
      else {

         # Color is supported, so we can use terminal underlining.
         if ( $have_color ) {
            my $left = int(($width - $cap_len) / 2);
            unshift @rows, [
               (" " x $left) . $caption . (" " x ($width - $left - $cap_len)),
               'underline',
            ];
         }

         # Color is not supported, so we have to add a line underneath to separate the
         # caption from whatever it's captioning.
         else {
            my $left = int(($width - $cap_len) / 2);
            unshift @rows, ('-' x $width);
            unshift @rows, (" " x $left) . $caption . (" " x ($width - $left - $cap_len));
         }

         # The caption is wider than the thing it labels, so we have to pad the
         # thing it labels to a consistent width.
         if ( $cap_len > $width ) {
            @rows = map {
               ref($_)
                  ? [ sprintf('%-' . $cap_len . 's', $_->[0]), $_->[1] ]
                  : sprintf('%-' . $cap_len . 's', $_);
            } @rows;
         }

      }
   }
   return @rows;
}

# create_table {{{3
# Input: an arrayref of columns, hashref of col info, and an arrayref of hashes
# Example: [ 'a', 'b' ]
#          { a => spec, b => spec }
#          [ { a => 1, b => 2}, { a => 3, b => 4 } ]
# The 'spec' is a hashref of hdr => label, just => ('-' or '').  It also supports min and max-widths
# vi the minw and maxw params.
# Output: an array of strings, one per row.
# Example:
# Column One Column Two
# ---------- ----------
# 1          2
# 3          4
sub create_table {
   my ( $cols, $info, $data, $prefs ) = @_;
   $prefs ||= {};
   $prefs->{no_hdr} ||= ($opts{n} && $clock != 1);

   my @rows = ();

   if ( @$cols && %$info ) {

      # Fix undef values, collapse whitespace.
      foreach my $row ( @$data ) {
         map { $row->{$_} = collapse_ws($row->{$_}) } @$cols;
      }

      my $col_sep = $opts{n} ? "\t" : '  ';

      # Find each column's max width.
      my %width_for;
      if ( !$opts{n} ) {
         %width_for = map {
            my $col_name  = $_;
            my $max_width = max( length($info->{$_}->{hdr}), map { length($_->{$col_name}) } @$data);
            if ( $info->{$col_name}->{maxw} ) {
               $max_width = min( $max_width, $info->{$col_name}->{maxw} );
            }
            if ( $info->{$col_name}->{minw} ) {
               $max_width = max( $max_width, $info->{$col_name}->{minw} );
            }
            $col_name => $max_width;
         } @$cols;
      }

      # The table header.
      if ( !$prefs->{no_hdr} ) {
         push @rows, $opts{n}
            ? join( $col_sep, @$cols )
            : join( $col_sep, map { sprintf( "%-$width_for{$_}s", trunc($info->{$_}->{hdr}, $width_for{$_}) ) } @$cols );
         if ( $have_color && $config{header_highlight}->{val} ) {
            push @rows, [ pop @rows, $config{header_highlight}->{val} ];
         }
         elsif ( !$opts{n} ) {
            push @rows, join( $col_sep, map { "-" x $width_for{$_} } @$cols );
         }
      }

      # The table data.
      if ( $opts{n} ) {
         foreach my $item ( @$data ) {
            push @rows, join($col_sep, map { $item->{$_} } @$cols );
         }
      }
      else {
         my $format = join( $col_sep,
            map { "%$info->{$_}->{just}$width_for{$_}s" } @$cols );
         foreach my $item ( @$data ) {
            my $row = sprintf($format, map { trunc($item->{$_}, $width_for{$_}) } @$cols );
            if ( $have_color && $item->{_color} ) {
               push @rows, [ $row, $item->{_color} ];
            }
            else {
               push @rows, $row;
            }
         }
      }
   }

   return @rows;
}

# set_to_tbl {{{3
# Unifies all the work of filtering, sorting etc.  Alters the input.
sub set_to_tbl {
   my ( $rows, $tbl ) = @_;
   my $meta = $tbl_meta{$tbl} or die "No such table $tbl in tbl_meta";

   # Apply filters.
   foreach my $filter ( @{$meta->{filters}} ) {
      eval {
         @$rows = grep { $filters{$filter}->{func}->($_) } @$rows;
      };
   }

   # Sort.
   if ( @$rows && $meta->{sort_func} ) {
      if ( $meta->{sort_dir} > 0 ) {
         @$rows = $meta->{sort_func}->( @$rows );
      }
      else {
         @$rows = reverse $meta->{sort_func}->( @$rows );
      }
   }

   # Stop altering arguments now.
   my @rows = @$rows;

   # Colorize.  Adds a _color column to rows.
   if ( @rows && $meta->{color_func} ) {
      eval {
         foreach my $row ( @rows ) {
            $row->{_color} = $meta->{color_func}->($row);
         }
      };
      if ( $EVAL_ERROR ) {
         pause($EVAL_ERROR);
      }
   }

   # Apply_transformations.
   if ( @rows ) {
      my $cols = $meta->{cols};
      foreach my $col ( keys %{$rows->[0]} ) {
         # Don't auto-vivify $tbl_meta{tbl}-{cols}->{_color}->{trans}
         next if $col eq '_color';
         foreach my $trans ( @{$cols->{$col}->{trans}} ) {
            map { $_->{$col} = $trans_funcs{$trans}->($_->{$col}) } @rows;
         }
      }
   }

   @rows = create_table( $meta->{visible}, $meta->{cols}, \@rows);
   if ( !$meta->{hide_hdr} && !$opts{n} && $config{display_table_captions}->{val} ) {
      @rows = create_caption($meta->{hdr}, @rows)
   }
   return @rows;
}

# meta_to_hdr {{{3
sub meta_to_hdr {
   my $tbl = shift;
   my $meta = $tbl_meta{$tbl};
   my %labels = map { $_ => $meta->{cols}->{$_}->{hdr} } @{$meta->{visible}};
   return \%labels;
}


# commify {{{3
# From perlfaq5: add commas.
sub commify {
   my $num = shift;
   $num =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
   return $num;
}

# set_precision {{{3
# Trim to desired precision.
sub set_precision {
   my ( $num, $precision ) = @_;
   sprintf("%.${precision}f", $num);
}

# percent {{{3
# Convert to percent
sub percent {
   my ( $num ) = @_;
   my $digits = $config{num_digits}->{val};
   sprintf("%.${digits}f", $num * 100);
}

# shorten {{{3
sub shorten {
   my ( $num, $opts ) = @_;

   return $num if !defined($num) || $opts{n} || $num =~ m/[^\d\.-]/;

   $opts ||= {};
   my $pad = defined $opts->{pad} ? $opts->{pad} : '';
   my $num_digits = defined $opts->{num_digits}
      ? $opts->{num_digits}
      : $config{num_digits}->{val};
   my $force = defined $opts->{force};

   my $n = 0;
   while ( $num >= 1_024 ) {
      $num /= 1_024;
      ++$n;
   }
   return sprintf(
      $num =~ m/\./ || $n || $force
         ? "%.${num_digits}f%s"
         : '%d',
      $num, ($pad,'k','M','G', 'T')[$n]);

}

# Utility functions {{{2
# unique {{{3
sub unique {
   my %seen;
   return grep { !$seen{$_}++ } @_;
}

# make_color_func {{{3
sub make_color_func {
   my ( $tbl ) = @_;
   my @criteria;
   foreach my $spec ( @{$tbl->{colors}} ) {
      next unless exists $comp_ops{$spec->{op}};
      my $val = $spec->{op} =~ m/^(?:eq|ne|le|ge|lt|gt)$/ ? "'$spec->{arg}'"
              : $spec->{op} =~ m/^(?:=~|!~)$/             ? "m/" . quotemeta($spec->{arg}) . "/"
              :                                             $spec->{arg};
      push @criteria,
         "( defined \$set->{$spec->{col}} && \$set->{$spec->{col}} $spec->{op} $val ) { return '$spec->{color}'; }";
   }
   return undef unless @criteria;
   my $sub = eval 'sub { my ( $set ) = @_; if ' . join(" elsif ", @criteria) . '}';
   die if $EVAL_ERROR;
   return $sub;
}

# make_sort_func {{{3
# Accepts a list of sort columns, like "+cxn -time" and returns a subroutine that will
# sort that way.
sub make_sort_func {
   my ( $tbl ) = @_;
   my @criteria;
   foreach my $col ( split(/\s+/, $tbl->{sort_cols} ) ) {
      next unless $col;
      my ( $dir, $name ) = $col =~ m/([+-])?(\w+)$/;
      next unless $name && $tbl->{cols}->{$name};
      $dir ||= '+';
      my $op = $tbl->{cols}->{$name}->{num} ? "<=>" : "cmp";
      my $df = $tbl->{cols}->{$name}->{num} ? "0"   : "''";
      push @criteria,
         $dir eq '+'
         ? "(\$a->{$name} || $df) $op (\$b->{$name} || $df)"
         : "(\$b->{$name} || $df) $op (\$a->{$name} || $df)";
   }
   return sub { return @_ } unless @criteria;
   my $sub = eval 'sub { sort {' . join("||", @criteria) . '} @_; }';
   die if $EVAL_ERROR;
   return $sub;
}

# trunc {{{3
# Shortens text to specified length.
sub trunc {
   my ( $text, $len ) = @_;
   if ( length($text) <= $len ) {
      return $text;
   }
   return substr($text, 0, $len);
}

# donut {{{3
# Takes out the middle of text to shorten it.
sub donut {
   my ( $text, $len ) = @_;
   return $text if length($text) <= $len;
   my $max = length($text) - $len;
   my $min = $max - 1;

   # Try to remove a single "word" from somewhere in the center
   if ( $text =~ s/_[^_]{$min,$max}_/_/ ) {
      return $text;
   }

   # Prefer removing the end of a "word"
   if ( $text =~ s/([^_]+)[^_]{$max}_/$1_/ ) {
      return $text;
   }

   $text = substr($text, 0, int($len/2))
         . "_"
         . substr($text, int($len/2) + $max + 1);
   return $text;
}

# crunch {{{3
# Removes vowels and compacts repeated letters to shorten text.
sub crunch {
   my ( $text, $len ) = @_;
   return $text if $len && length($text) <= $len;
   $text =~ s/^IB_\w\w_//;
   $text =~ s/(?<![_ ])[aeiou]//g;
   $text =~ s/(.)\1+/$1/g;
   return $text;
}

# collapse_ws {{{3
# Collapses all whitespace to a single space.
sub collapse_ws {
   my ( $text ) = @_;
   return '' unless defined $text;
   $text =~ s/\s+/ /g;
   return $text;
}

# Strips out non-printable characters within fields, which freak terminals out.
sub no_ctrl_char {
   my ( $text ) = @_;
   return '' unless defined $text;
   my $charset = $config{charset}->{val};
   if ( $charset && $charset eq 'unicode' ) {
      $text =~ s/
         ("(?:(?!(?<!\\)").)*"  # Double-quoted string
         |'(?:(?!(?<!\\)').)*') # Or single-quoted string
         /$1 =~ m#\p{IsC}# ? "[BINARY]" : $1/egx;
   }
   elsif ( $charset && $charset eq 'none' ) {
      $text =~ s/
         ("(?:(?!(?<!\\)").)*"
         |'(?:(?!(?<!\\)').)*')
         /[TEXT]/gx;
   }
   else { # The default is 'ascii'
      $text =~ s/
         ("(?:(?!(?<!\\)").)*"
         |'(?:(?!(?<!\\)').)*')
         /$1 =~ m#[^\040-\176]# ? "[BINARY]" : $1/egx;
   }
   return $text;
}

# word_wrap {{{3
# Wraps text at word boundaries so it fits the screen.
sub word_wrap {
   my ( $text, $width) = @_;
   $width ||= $this_term_size[0];
   $text =~ s/(.{0,$width})(?:\s+|$)/$1\n/g;
   $text =~ s/\s+$//;
   return $text;
}

# draw_screen {{{3
# Prints lines to the screen.  The first argument is an arrayref.  Each
# element of the array is either a string or an arrayref.  If it's a string it
# just gets printed.  If it's an arrayref, the first element is the string to
# print, and the second is args to colored().
sub draw_screen {
   my ( $display_lines, $prefs ) = @_;
   if ( !$opts{n} && $config{show_statusbar}->{val} ) {
      unshift @$display_lines, create_statusbar();
   }
   $clear_screen_sub->() unless $modes{$config{mode}->{val}}->{no_clear_screen};
   if ( $opts{n} || $prefs->{raw} ) {
      print join("\n",
         map {
            ref $_
               ? colored($_->[0], $_->[1])
               : $_;
         }
         grep { !$opts{n} || $_ } # When non-interactive, suppress empty lines
         @$display_lines);
      if ( $opts{n} ) {
         print "\n";
      }
   }
   elsif ( $prefs->{show_all} ) {
      print join("\n",
            map {
               ref $_
                  ? colored(substr($_->[0], 0, $this_term_size[0]), $_->[1])
                  : substr($_, 0, $this_term_size[0]);
            }
         @$display_lines);
   }
   else {
      my $max_lines = min(scalar(@$display_lines), $this_term_size[1]);
      print join("\n",
         map {
            ref $_
               ? colored(substr($_->[0], 0, $this_term_size[0]), $_->[1])
               : substr($_, 0, $this_term_size[0]);
         } @$display_lines[0..$max_lines - 1]);
   }
}

# secs_to_time {{{3
sub secs_to_time {
   my ( $secs, $fmt ) = @_;
   $secs ||= 0;
   return '00:00' unless $secs;

   # Decide what format to use, if not given
   $fmt ||= $secs >= 86_400 ? 'd'
          : $secs >= 3_600  ? 'h'
          :                   'm';

   return
      $fmt eq 'd' ? sprintf(
         "%d+%02d:%02d:%02d",
         int($secs / 86_400),
         int(($secs % 86_400) / 3_600),
         int(($secs % 3_600) / 60),
         $secs % 60)
      : $fmt eq 'h' ? sprintf(
         "%02d:%02d:%02d",
         int(($secs % 86_400) / 3_600),
         int(($secs % 3_600) / 60),
         $secs % 60)
      : sprintf(
         "%02d:%02d",
         int(($secs % 3_600) / 60),
         $secs % 60);
}

# dulint_to_int {{{3
# Takes a number that InnoDB formats as two ulint integers, like transaction IDs
# and such, and turns it into a single integer
sub dulint_to_int {
   my $num = shift;
   return 0 unless $num;
   my ( $high, $low ) = $num =~ m/^(\d+) (\d+)$/;
   return $low unless $high;
   return $low + ( $high * $MAX_ULONG );
}

# create_statusbar {{{3
sub create_statusbar {
   my $mode = $config{mode}->{val};
   my @cxns = sort { $a cmp $b } get_connections();

   my $modeline        = ( $config{readonly}->{val} ? '[RO] ' : '' )
                         . $modes{$mode}->{hdr} . " (? for help)";
   my $mode_width      = length($modeline);
   my $remaining_width = $this_term_size[0] - $mode_width - 1;
   my $result;

   # The thingie in top-right that says what we're monitoring.
   my $cxn = '';

   if ( 1 == @cxns ) {
      $cxn = $dbhs{$cxns[0]}->{mysql_version};
   }
   else {
      if ( $modes{$mode}->{server_group} ) {
         $cxn = "Servers: " . $modes{$mode}->{server_group};
         my $err_count = grep { $dbhs{$_}->{err_count} } @cxns;
         if ( $err_count ) {
            $cxn .= "(" . ( scalar(@cxns) - $err_count ) . "/" . scalar(@cxns) . ")";
         }
      }
      else {
         $cxn = join(' ', map { ($dbhs{$_}->{err_count} ? '!' : '') . $_ } @cxns);
      }
   }

   if ( 1 == @cxns ) {
      get_status_info(@cxns);
      my $vars = $vars{$cxns[0]}->{$clock};

      # Format server uptime human-readably.
      my $uptime = secs_to_time( $vars->{Uptime} );
      my $inc    = inc(0, $cxns[0]);
      my $qps    = set_precision($exprs{QPS}->{func}->($inc), 2);
      my $ibinfo = '';

      if ( exists $vars->{IB_last_secs} ) {
         $ibinfo .= "InnoDB $vars->{IB_last_secs} sec ";
         if ( $vars->{IB_got_all} ) {
            if ( ($mode eq 'T' || $mode eq 'W')
                  && $vars->{IB_tx_is_truncated} ) {
               $ibinfo .= ':^|, ';
            }
            else {
               $ibinfo .= ':-), ';
            }
         }
         else {
            $ibinfo .= ':-(, ';
         }
      }
      $result = sprintf(
         "%-${mode_width}s %${remaining_width}s",
         $modeline,
         $ibinfo . join(', ',
            "$qps QPS",
            $cxns[0],
            ($vars->{Threads_connected} || 0) . " thd",
            $uptime,
            $cxn));
   }
   else {
      $result = sprintf(
         "%-${mode_width}s %${remaining_width}s",
         $modeline,
         $cxn);
   }

   return [ $result, 'bold reverse' ];
}

# Database connections {{{3
sub add_new_dsn {
   my ( $name ) = @_;

   if ( defined $name ) {
      $name =~ s/[\s:;]//g;
   }

   if ( !$name ) {
      print word_wrap("Choose a name for the connection.  It cannot contain "
         . "whitespace, colons or semicolons."), "\n\n";
      do {
         $name = prompt("Enter a name");
         $name =~ s/[\s:;]//g;
      } until ( $name );
   }

   my $dsn;
   do {
      $clear_screen_sub->();
      print "Typical DSN strings look like\n   DBI:mysql:db;host=hostname;port=port\n"
         . "The db and port are optional and can typically be omitted.\n\n";
      $dsn = prompt("Enter a DSN string", undef, "DBI:mysql:;host=$name");
   } until ( $dsn );

   my $user = $ENV{USERNAME} || $ENV{USER} || getlogin() || getpwuid($REAL_USER_ID) || undef;
   do {
      $clear_screen_sub->();
      $user = prompt("Enter a username for $name", undef, $user);
   } until ( $user );

   $clear_screen_sub->();
   my $dl_table = prompt("Optional: enter a table (must not exist) to use when resetting InnoDB deadlock information",
      undef, 'test.innodb_deadlock_maker');

   $connections{$name} = {
      dsn      => $dsn,
      user     => $user,
      dl_table => $dl_table,
   };
}

sub add_new_server_group {
   my ( $name ) = @_;

   if ( defined $name ) {
      $name =~ s/[\s:;]//g;
   }

   if ( !$name ) {
      print word_wrap("Choose a name for the group.  It cannot contain "
         . "whitespace, colons or semicolons."), "\n\n";
      do {
         $name = prompt("Enter a name");
         $name =~ s/[\s:;]//g;
      } until ( $name );
   }

   my @cxns;
   do {
      $clear_screen_sub->();
      @cxns = select_cxn("Choose servers for $name", keys %connections);
   } until ( @cxns );

   $server_groups{$name} = \@cxns;
}

sub get_var_set {
   my ( $name ) = @_;
   while ( !exists($var_sets{$config{$name}->{val}}) ) {
      $name = choose_var_set($name);
   }
   return $var_sets{$config{$name}->{val}};
}

sub add_new_var_set {
   my ( $name ) = @_;

   if ( defined $name ) {
      $name =~ s/\W//g;
   }

   if ( !$name ) {
      do {
         $name = prompt("Enter a name");
         $name =~ s/\W//g;
      } until ( $name );
   }

   my $variables;
   do {
      $clear_screen_sub->();
      $variables = prompt("Enter variables for $name", undef );
   } until ( $variables );

   $var_sets{$name} = [ unique(grep { $_ } split(/\s+/, $variables)) ];
}

sub next_server_group {
   my $mode = shift || $config{mode}->{val};
   my @grps = sort keys %server_groups;
   my $curr = $modes{$mode}->{server_group};

   return unless @grps;

   if ( $curr ) {
      # Find the current group's position.
      my $pos = 0;
      while ( $curr ne $grps[$pos] ) {
         $pos++;
      }
      $modes{$mode}->{server_group} = $grps[ ($pos + 1) % @grps ];
   }
   else {
      $modes{$mode}->{server_group} = $grps[0];
   }
}

# Get a list of connection names used in this mode.
sub get_connections {
   my $mode = shift || $config{mode}->{val};
   my @connections = $modes{$mode}->{server_group}
      ? @{$server_groups{$modes{$mode}->{server_group}}}
      : @{$modes{$mode}->{connections}};
   if ( $modes{$mode}->{one_connection} ) {
      @connections = @connections ? $connections[0] : ();
   }
   return unique(@connections);
}

# Get a list of tables used in this mode.  If innotop is running non-interactively, just use the first.
sub get_visible_tables {
   my $mode = shift || $config{mode}->{val};
   my @tbls = @{$modes{$mode}->{visible_tables}};
   if ( $opts{n} ) {
      return $tbls[0];
   }
   else {
      return @tbls;
   }
}

# Choose from among available connections or server groups.
# If the mode has a server set in use, prefers that instead.
sub choose_connections {
   $clear_screen_sub->();
   my $mode    = $config{mode}->{val};
   my $meta    =  { map { $_ => $connections{$_}->{dsn} } keys %connections };
   foreach my $group ( keys %server_groups ) {
      $meta->{"#$group"} = join(' ', @{$server_groups{$group}});
   }

   my $choices = prompt_list("Choose connections or a group for $mode mode",
      undef, sub { return keys %$meta }, $meta);

   my @choices = unique(grep { $_ } split(/\s+/, $choices));
   if ( @choices ) {
      if ( $choices[0] =~ s/^#// && exists $server_groups{$choices[0]} ) {
         $modes{$mode}->{server_group} = $choices[0];
      }
      else {
         $modes{$mode}->{connections} = [ grep { exists $connections{$_} } @choices ];
      }
   }
}

# Accepts a DB connection name and the name of a prepared query (e.g. status, kill).
# Also a list of params for the prepared query.  This allows not storing prepared
# statements globally.  Returns a $sth that's been executed.
# ERROR-HANDLING SEMANTICS: if the statement throws an error, propagate, but if the
# connection has gone away or can't connect, DO NOT.  Just return undef.
sub do_stmt {
   my ( $cxn, $stmt_name, @args ) = @_;

   # Test if the cxn should not even be tried
   return undef
      if $dbhs{$cxn} && $dbhs{$cxn}->{err_count} && $dbhs{$cxn}->{wake_up} > $clock;

   my $sth;
   my $retries = 1;
   my $success = 0;
   TRY:
   while ( $retries-- >= 0 && !$success ) {

      eval {
         my $dbh = connect_to_db($cxn);

         # If the prepared query doesn't exist, make it.
         if ( !exists $dbhs{$cxn}->{stmts}->{$stmt_name} ) {
            $dbhs{$cxn}->{stmts}->{$stmt_name}
               = $dbh->prepare($stmt_maker_for{$stmt_name}->($cxn));
         }

         $sth = $dbhs{$cxn}->{stmts}->{$stmt_name};
         $sth->execute(@args);
         $success = 1;
      };
      if ( $EVAL_ERROR ) {
         my $errs = join('|',
            'Access denied for user',
            'Unknown MySQL server host',
            'Unknown database',
            'Can\'t connect to local MySQL server through socket',
            'Can\'t connect to MySQL server on',
            'MySQL server has gone away',
            'Cannot call SHOW INNODB STATUS',
            'Access denied',
         );
         if ( $EVAL_ERROR =~ m/$errs/ ) {
            handle_cxn_error($cxn, $EVAL_ERROR);
         }
         else {
            die $EVAL_ERROR;
         }
         if ( $retries < 0 ) {
            $sth = undef;
         }
      }
   }

   return $sth;
}

# Keeps track of error count, sleep times till retries, etc etc.
# When there's an error we retry the connection every so often, increasing in
# Fibonacci series to prevent too much banging on the server.
sub handle_cxn_error {
   my ( $cxn, $err ) = @_;
   my $meta = $dbhs{$cxn};
   $meta->{err_count}++;

   # Strip garbage from the error text if possible.
   $err =~ s/\s+/ /g;
   if ( $err =~ m/failed: (.*?) at \S*innotop line/ ) {
      $err = $1;
   }

   $meta->{last_err}   = $err;
   my $sleep_time      = $meta->{this_sleep} + $meta->{prev_sleep};
   $meta->{prev_sleep} = $meta->{this_sleep};
   $meta->{this_sleep} = $sleep_time;
   $meta->{wake_up}    = $clock + $sleep_time;
   if ( $config{show_cxn_errors}->{val} ) {
      print STDERR "Error at tick $clock $cxn $err" if $config{debug}->{val};
   }
}

# Accepts a DB connection name and a (string) query.  Returns a $sth that's been
# executed.
sub do_query {
   my ( $cxn, $query ) = @_;

   # Test if the cxn should not even be tried
   return undef
      if $dbhs{$cxn} && $dbhs{$cxn}->{err_count} && $dbhs{$cxn}->{wake_up} > $clock;

   my $sth;
   my $retries = 1;
   my $success = 0;
   TRY:
   while ( $retries-- >= 0 && !$success ) {

      eval {
         my $dbh = connect_to_db($cxn);

         $sth = $dbh->prepare($query);
         $sth->execute();
         $success = 1;
      };
      if ( $EVAL_ERROR ) {
         my $errs = join('|',
            'Access denied for user',
            'Unknown MySQL server host',
            'Unknown database',
            'Can\'t connect to local MySQL server through socket',
            'Can\'t connect to MySQL server on',
            'MySQL server has gone away',
         );
         if ( $EVAL_ERROR =~ m/$errs/ ) {
            handle_cxn_error($cxn, $EVAL_ERROR);
         }
         else {
            die $EVAL_ERROR;
         }
         if ( $retries < 0 ) {
            $sth = undef;
         }
      }
   }
 
   return $sth;
}

sub connect_to_db {
   my ( $cxn ) = @_;

   $dbhs{$cxn} ||= {
      stmts      => {},  # bucket for prepared statements.
      prev_sleep => 0,
      this_sleep => 1,
      wake_up    => 0,
      start_time => 0,
      dbh        => undef,
   };
   my $href = $dbhs{$cxn};

   if ( !$href->{dbh} || !$href->{dbh}->ping ) {
      my $dbh = get_new_db_connection($cxn);
      $href->{dbh} = $dbh;

      # Get version and connection ID.  This is necessary to do repeatedly
      # because we may disconnect and connect again.
      my ($version, $connection_id)
         = $dbh->selectrow_array("SELECT VERSION(), CONNECTION_ID()");
      @{$href}{qw(mysql_version connection_id)} = ($version, $connection_id);
      @{$href}{qw(ver_major ver_minor ver_rev)} = $version =~ m/^(\d+)\.(\d+)\.(\d+)/;

      # Derive and store the server's start time in hi-res
      my $uptime = $dbh->selectrow_hashref("show status like 'Uptime'")->{Value};
      $href->{start_time} = time() - $uptime;

      # Set timeouts to 8 hours so an unused connection stays alive
      # (for example, a connection might be used in Q mode but idle in T mode).
      $dbh->do("set session wait_timeout=28800, interactive_timeout=28800");
   }
   return $href->{dbh};
}

sub get_new_db_connection {
   my ( $connection, $destroy ) = @_;
   my $dsn = $connections{$connection};
   if ( !$dsn->{pass} && !$dsn->{savepass} ) {
      $dsn->{pass} = prompt_noecho("Enter password for $dsn->{user} on $connection");
      if ( !defined($dsn->{savepass}) ) {
         print "\n";
         $dsn->{savepass} = prompt("Save password in plain text in the config file? 1 or 0", undef, 1);
      }
   }
   my $dbh = DBI->connect(
      $dsn->{dsn}, $dsn->{user}, $dsn->{pass},
      { RaiseError => 1, PrintError => 0, AutoCommit => 1 });
   $dbh->{InactiveDestroy} = 1 unless $destroy; # Can't be set in $db_options
   return $dbh;
}

sub get_cxn_errors {
   my @cxns = @_;
   return () unless $config{show_cxn_errors_in_tbl}->{val};
   return
      map  { [ $_ . ': ' . $dbhs{$_}->{last_err}, 'red' ] }
      grep { $dbhs{$_}->{err_count} }
      @cxns;
}

# Setup and tear-down functions {{{2
# compile_filter {{{3
sub compile_filter {
   my ( $text ) = @_;
   my ( $sub, $err );
   eval "\$sub = sub { my \$set = shift; $text }";
   if ( $EVAL_ERROR ) {
      $sub = sub { return $EVAL_ERROR };
      $err = $EVAL_ERROR;
   }
   return ( $sub, $err );
}

# compile_expr {{{3
# TODO: strip off "at (eval..." from error.
sub compile_expr {
   my ( $expr, $simple ) = @_;
   if ( $simple ) {
      $expr =~ s/([A-Za-z]\w+)/\$set->{$1}/g;
   }
   my ( $sub, $err );
   eval "\$sub = sub { my \$set = shift; $expr }";
   if ( $EVAL_ERROR ) {
      $sub = sub { return $EVAL_ERROR };
      $err = $EVAL_ERROR;
   }
   return ( $sub, $err );
}

# finish {{{3
# This is a subroutine because it's called from a key to quit the program.
sub finish {
   save_config();
   ReadMode('normal') unless $opts{n};
   print "\n";
   exit(0);
}

# core_dump {{{3
sub core_dump {
   my $msg = shift;
   if ($config{debugfile}->{val} && $config{debug}->{val}) {
      eval {
         open my $file, '>>', $config{debugfile}->{val};
         if ( %vars ) {
            print $file "Current variables:\n" . Dumper(\%vars);
         }
         close $file;
      };
   }
   print $msg;
}

# load_config {{{3
sub load_config {

   my $filename = $opts{c} || "$homepath/.innotop";
   if ( -f $filename ) {
      open my $file, "<", $filename or die("Can't open $filename: $OS_ERROR");

      # Check config file version.  Just ignore if either innotop or the file has
      # garbage in the version number.
      if ( defined(my $line = <$file>) && $VERSION =~ m/\d/ ) {
         chomp $line;
         if ( my ($maj, $min, $rev) = $line =~ m/^version=(\d+)\.(\d+)(?:\.(\d+))?$/ ) {
            $rev ||= 0;
            my $cfg_ver          = sprintf('%03d-%03d-%03d', $maj, $min, $rev);
            ( $maj, $min, $rev ) = $VERSION =~ m/^(\d+)\.(\d+)(?:\.(\d+))?$/;
            $rev ||= 0;
            my $innotop_ver      = sprintf('%03d-%03d-%03d', $maj, $min, $rev);

            if ( $cfg_ver gt $innotop_ver ) {
               pause("The config file is for a newer version of innotop and may not be read correctly.");
            }
            else {
               my @ver_history = @config_versions;
               while ( my ($start, $end) = splice(@ver_history, 0, 2) ) {
                  # If the config file is between the endpoints and innotop is greater than
                  # the endpoint, innotop has a newer config file format than the file.
                  if ( $cfg_ver ge $start && $cfg_ver lt $end && $innotop_ver ge $end ) {
                     my $msg = "Innotop's config file format has changed.  Overwrite $filename?  y or n";
                     if ( pause($msg) eq 'n' ) {
                        $config{readonly}->{val} = 1;
                        print "\nInnotop will not save any configuration changes you make.";
                        pause();
                        print "\n";
                     }
                     close $file;
                     return;
                  }
               }
            }
         }
      }

      while ( my $line = <$file> ) {
         chomp $line;
         next unless $line =~ m/^\[([a-z_]+)\]$/;
         if ( exists $config_file_sections{$1} ) {
            $config_file_sections{$1}->{reader}->($file);
         }
         else {
            warn "Unknown config file section '$1'";
         }
      }
      close $file or die("Can't close $filename: $OS_ERROR");
   }

}

# Do some post-processing on %tbl_meta: compile src properties into func etc.
# TODO: allow 'foo/bar as bif' syntax.
sub post_process_tbl_meta {
   foreach my $table ( values %tbl_meta ) {
      foreach my $col_name ( keys %{$table->{cols}} ) {
         my $col_def = $table->{cols}->{$col_name};
         my ( $sub, $err )
            = $col_def->{expr}
            ? $col_def->{src}->{func} # Already compiled
            : compile_expr($col_def->{src}, 1);
         $col_def->{func} = $sub;
      }
   }
}

# load_config_active_server_groups {{{3
sub load_config_active_server_groups {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $mode, $group ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $mode && $group;
      $modes{$mode}->{server_group} = $group;
   }
}

# save_config_active_server_groups {{{3
sub save_config_active_server_groups {
   my $file = shift;
   foreach my $mode ( keys %modes ) {
      print $file "$mode=$modes{$mode}->{server_group}\n";
   }
}

# load_config_server_groups {{{3
sub load_config_server_groups {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $name, $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $name && $rest;
      my @vars = unique(grep { $_ && exists $connections{$_} } split(/\s+/, $rest));
      next unless @vars;
      $server_groups{$name} = \@vars;
   }
}

# save_config_server_groups {{{3
sub save_config_server_groups {
   my $file = shift;
   foreach my $set ( keys %server_groups ) {
      print $file "$set=", join(' ', @{$server_groups{$set}}), "\n";
   }
}

# load_config_varsets {{{3
sub load_config_varsets {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $name, $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $name && $rest;
      my @vars = unique(map { $_ } split(/\s+/, $rest));
      next unless @vars;
      $var_sets{$name} = \@vars;
   }
}

# save_config_varsets {{{3
sub save_config_varsets {
   my $file = shift;
   foreach my $varset ( keys %var_sets ) {
      print $file "$varset=", join(' ', @{$var_sets{$varset}}), "\n";
   }
}

# load_config_filters {{{3
sub load_config_filters {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key, $rest ) = $line =~ m/^(.+?)=(.*)$/;
      next unless $key && $rest;

      my %parts = $rest =~ m/(\w+)='((?:(?!(?<!\\)').)*)'/g; # Properties are single-quoted
      next unless $parts{text} && $parts{tbls};

      foreach my $prop ( keys %parts ) {
         # Un-escape escaping
         $parts{$prop} =~ s/\\\\/\\/g;
         $parts{$prop} =~ s/\\'/'/g;
      }

      my ( $sub, $err ) = compile_filter($parts{text});
      my @tbls = unique(split(/\s+/, $parts{tbls}));
      @tbls = grep { exists $tbl_meta{$_} } @tbls;
      $filters{$key} = {
         func => $sub,
         text => $parts{text},
         user => 1,
         name => $key,
         note => 'User-defined filter',
         tbls => \@tbls,
      }
   }
}

# save_config_filters {{{3
sub save_config_filters {
   my $file = shift;
   foreach my $key ( keys %filters ) {
      next unless $filters{$key}->{user};
      my $text = $filters{$key}->{text};
      $text =~ s/([\\'])/\\$1/g;
      my $tbls = join(" ", @{$filters{$key}->{tbls}});
      print $file "$key=text='$text' tbls='$tbls'\n";
   }
}

# load_config_visible_tables {{{3
sub load_config_visible_tables {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $mode, $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $mode;
      if ( exists $modes{$mode} ) {
         $modes{$mode}->{visible_tables} =
            [ unique(grep { $_ && exists $tbl_meta{$_} } split(/\s+/, $rest)) ];
      }
   }
}

# save_config_visible_tables {{{3
sub save_config_visible_tables {
   my $file = shift;
   foreach my $mode ( keys %modes ) {
      my $tables = $modes{$mode}->{visible_tables};
      print $file "$mode=", join(' ', @$tables), "\n";
   }
}

# load_config_sort_cols {{{3
sub load_config_sort_cols {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $key;
      $tbl_meta{$key}->{sort_cols} = $rest;
      $tbl_meta{$key}->{sort_func} = make_sort_func($tbl_meta{$key});
   }
}

# save_config_sort_cols {{{3
sub save_config_sort_cols {
   my $file = shift;
   foreach my $tbl ( keys %tbl_meta ) {
      my $col = $tbl_meta{$tbl}->{sort_cols};
      print $file "$tbl=$col\n";
   }
}

# load_config_active_filters {{{3
sub load_config_active_filters {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $tbl , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $tbl && exists $tbl_meta{$tbl};
      my @parts = unique(grep { exists($filters{$_}) } split(/\s+/, $rest));
      @parts = grep { grep { $tbl eq $_ } @{$filters{$_}->{tbls}} } @parts;
      $tbl_meta{$tbl}->{filters} = [ @parts ];
   }
}

# save_config_active_filters {{{3
sub save_config_active_filters {
   my $file = shift;
   foreach my $tbl ( keys %tbl_meta ) {
      my $aref = $tbl_meta{$tbl}->{filters};
      print $file "$tbl=", join(' ', @$aref), "\n";
   }
}

# load_config_active_columns {{{3
sub load_config_active_columns {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $key && exists $tbl_meta{$key};
      my @parts = grep { exists($tbl_meta{$key}->{cols}->{$_}) } unique split(/ /, $rest);
      $tbl_meta{$key}->{visible} = [ @parts ];
   }
}

# save_config_active_columns {{{3
sub save_config_active_columns {
   my $file = shift;
   foreach my $tbl ( keys %tbl_meta ) {
      my $aref = $tbl_meta{$tbl}->{visible};
      print $file "$tbl=", join(' ', @$aref), "\n";
   }
}

# load_config_expressions {{{3
sub load_config_expressions {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key, $expr ) = $line =~ m/^(.+?)=(.*)$/;
      next unless $key && $expr;

      my ( $sub, $err ) = compile_expr($expr);
      $exprs{$key} = {
         func => $sub,
         text => $expr,
         user => 1,
         name => $key,
      }
   }
}

# save_config_expressions {{{3
sub save_config_expressions {
   my $file = shift;
   foreach my $key ( keys %exprs ) {
      next unless $exprs{$key}->{user};
      print $file "$key=$exprs{$key}->{text}\n";
   }
}

# save_config_tbl_meta {{{3
sub save_config_tbl_meta {
   my $file = shift;
   foreach my $tbl ( keys %tbl_meta ) {
      foreach my $col ( keys %{$tbl_meta{$tbl}->{cols}} ) {
         my $meta = $tbl_meta{$tbl}->{cols}->{$col};
         next unless $meta->{user};
         print $file "$col=", join(
            " ",
            map {
               # Some properties (trans) are arrays, others scalars
               my $val = ref($meta->{$_}) ? join(',', @{$meta->{$_}}) : $meta->{$_};
               $val =~ s/([\\'])/\\$1/g;  # Escape backslashes and single quotes
               "$_='$val'";               # Enclose in single quotes
            }
            grep { $_ ne 'func' }
            keys %$meta
         ), "\n";
      }
   }
}

# save_config_config {{{3
sub save_config_config {
   my $file = shift;
   foreach my $key ( sort keys %config ) {
      eval {
      if ( $key ne 'password' || $config{savepass}->{val} ) {
         print $file "# $config{$key}->{note}\n"
            or die "Cannot print to file: $OS_ERROR";
         my $val = $config{$key}->{val};
         $val = '' unless defined($val);
         if ( ref( $val ) eq 'ARRAY' ) {
            print $file "$key="
               . join( " ", @$val ) . "\n"
               or die "Cannot print to file: $OS_ERROR";
         }
         elsif ( ref( $val ) eq 'HASH' ) {
            print $file "$key="
               . join( " ",
                  map { "$_:$val->{$_}" } keys %$val
               ) . "\n";
         }
         else {
            print $file "$key=$val\n";
         }
      }
      };
      if ( $EVAL_ERROR ) { print "$EVAL_ERROR in $key"; };
   }

}

# load_config_config {{{3
sub load_config_config {
   my ( $file ) = @_;

   # Look in the command-line parameters for things stored in the same slot.
   my %cmdline =
      map  { $opt_spec{$_}->{config} => $opts{$_} }
      grep { exists $opt_spec{$_}->{config} && exists $opts{$_} }
      keys %opt_spec;

   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $name, $val ) = $line =~ m/^(.+?)=(.*)$/;
      next unless defined $name && defined $val;

      # Values might already have been set at the command line.
      $val = defined($cmdline{$name}) ? $cmdline{$name} : $val;

      # Validate the incoming values...
      if ( $name && exists( $config{$name} ) ) {
         if ( !$config{$name}->{pat} || $val =~ m/$config{$name}->{pat}/ ) {
            $config{$name}->{val} = $val;
            $config{$name}->{read} = 1;
         }
      }
   }
}

# load_config_tbl_meta {{{3
sub load_config_tbl_meta {
   my ( $file ) = @_;

   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      # Each tbl_meta section has all the properties defined in %col_props.  If expr
      # is set, it gets looked up by name.  That's why load_config_expressions() has
      # to be called before this.
      my ( $col , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $col;
      my %parts = $rest =~ m/(\w+)='((?:(?!(?<!\\)').)*)'/g; # Properties are single-quoted

      # Each section read from the config file has one extra property: which table it
      # goes in.
      my $tbl  = $parts{tbl}     or die "There's no table for tbl_meta $col";
      my $meta = $tbl_meta{$tbl} or die "There's no table in tbl_meta named $tbl";

      # The section is user-defined by definition (if that makes sense).
      $parts{user} = 1;

      # The column may already exist in the table, in which case this is just a
      # customization.
      $meta->{cols}->{$col} ||= {};

      foreach my $prop ( keys %col_props ) {
         if ( !defined($parts{$prop}) ) {
            die "Undefined property $prop for column $col in table $tbl";
         }

         # Un-escape escaping
         $parts{$prop} =~ s/\\\\/\\/g;
         $parts{$prop} =~ s/\\'/'/g;

         if ( ref $col_props{$prop} ) {
            if ( $prop eq 'trans' ) {
               $meta->{cols}->{$col}->{trans}
                  = [ unique(grep { exists $trans_funcs{$_} } split(',', $parts{$prop})) ];
            }
            else {
               $meta->{cols}->{$col}->{$prop} = [ split(',', $parts{$prop}) ];
            }
         }
         else {
            $meta->{cols}->{$col}->{$prop} = $parts{$prop};
         }
      }
      if ( $meta->{cols}->{$col}->{expr} ) {
         $meta->{cols}->{$col}->{src} = $exprs{$parts{expr}}
            or die "There's no expression named $parts{expr} for column $col in table $tbl";
      }

   }
}

# save_config {{{3
sub save_config {
   return if $config{readonly}->{val};
   # Save to a temp file first, so a crash doesn't destroy the main config file
   my $newname  = $opts{c} || "$homepath/.innotop";
   my $filename = $newname . '_tmp';
   open my $file, "+>", $filename
      or die("Can't write to $filename: $OS_ERROR");
   print $file "version=$VERSION\n";

   foreach my $section ( @ordered_config_file_sections ) {
      die "No such config file section $section" unless $config_file_sections{$section};
      print $file "\n[$section]\n\n";
      $config_file_sections{$section}->{writer}->($file);
      print $file "\n[/$section]\n";
   }

   # Now clobber the main config file with the temp.
   close $file or die("Can't close $filename: $OS_ERROR");
   rename($filename, $newname) or die("Can't rename $filename to $newname: $OS_ERROR");
}

# load_config_connections {{{3
sub load_config_connections {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $key;
      my %parts = $rest =~ m/(\S+?)=(\S*)/g;
      my %conn  = map { $_ => $parts{$_} || '' } @conn_parts;
      $connections{$key} = \%conn;
   }
}

# save_config_connections {{{3
sub save_config_connections {
   my $file = shift;
   foreach my $conn ( keys %connections ) {
      my $href = $connections{$conn};
      my @keys = $href->{savepass} ? @conn_parts : grep { $_ ne 'pass' } @conn_parts;
      print $file "$conn=", join(' ', map { "$_=$href->{$_}" } @keys), "\n";
   }
}

sub load_config_colors {
   my ( $file ) = @_;
   my %rule_set_for;

   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $tbl, $rule ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $tbl && $rule;
      next unless exists $tbl_meta{$tbl};
      my %parts = $rule =~ m/(\w+)='((?:(?!(?<!\\)').)*)'/g; # Properties are single-quoted
      next unless $parts{col} && exists $tbl_meta{$tbl}->{cols}->{$parts{col}};
      next unless $parts{op}  && exists $comp_ops{$parts{op}};
      next unless defined $parts{arg};
      next unless defined $parts{color};
      my @colors = unique(grep { exists $ansicolors{$_} } split(/\W+/, $parts{color}));
      next unless @colors;

      # Finally!  Enough validation...
      $rule_set_for{$tbl} ||= [];
      push @{$rule_set_for{$tbl}}, \%parts;
   }

   foreach my $tbl ( keys %rule_set_for ) {
      $tbl_meta{$tbl}->{colors} = $rule_set_for{$tbl};
      $tbl_meta{$tbl}->{color_func} = make_color_func($tbl_meta{$tbl});
   }
}

# save_config_colors {{{3
sub save_config_colors {
   my $file = shift;
   foreach my $tbl ( keys %tbl_meta ) {
      my $meta = $tbl_meta{$tbl};
      foreach my $rule ( @{$meta->{colors}} ) {
         print $file "$tbl=", join(
            ' ',
            map {
               my $val = $rule->{$_};
               $val =~ s/([\\'])/\\$1/g;  # Escape backslashes and single quotes
               "$_='$val'";               # Enclose in single quotes
            }
            qw(col op arg color)
         ), "\n";
      }
   }
}

# load_config_active_connections {{{3
sub load_config_active_connections {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key , $rest ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $key;
      my @parts = split(/ /, $rest);
      $modes{$key}->{connections} = [ @parts ] if exists $modes{$key};
   }
}

# save_config_active_connections {{{3
sub save_config_active_connections {
   my $file = shift;
   foreach my $mode ( keys %modes ) {
      my @connections = get_connections($mode);
      print $file "$mode=", join(' ', @connections), "\n";
   }
}

# load_config_mvs {{{3
sub load_config_mvs {
   my ( $file ) = @_;
   while ( my $line = <$file> ) {
      chomp $line;
      next if $line =~ m/^#/;
      last if $line =~ m/^\[/;

      my ( $key , $val ) = $line =~ m/^(.*?)=(.*)$/;
      next unless $key;
      $mvs{$key} = $val;
   }
}

# save_config_mvs {{{3
sub save_config_mvs {
   my $file = shift;
   foreach my $key ( keys %mvs ) {
      print $file "$key=$mvs{$key}\n";
   }
}

# edit_configuration {{{3
sub edit_configuration {
   my $key = '';
   while ( $key ne 'q' ) {
      $clear_screen_sub->();
      my @display_lines = '';

      if ( $key && $cfg_editor_action{$key} ) {
         $cfg_editor_action{$key}->{func}->();
      }

      # Show help
      push @display_lines, create_caption('What configuration do you want to edit?',
      create_table2(
         [ sort keys %cfg_editor_action ],
         { map { $_ => $_ } keys %cfg_editor_action },
         { map { $_ => $cfg_editor_action{$_}->{note} } keys %cfg_editor_action },
         { sep => '  ' }));

      draw_screen(\@display_lines);
      $key = pause('');
   }
}

# edit_configuration_variables {{{3
sub edit_configuration_variables {
   $clear_screen_sub->();
   my $mode = $config{mode}->{val};

   my %config_choices
      = map  { $_ => $config{$_}->{note} || '' }
        # Only config values that are marked as applying to this mode.
        grep {
           my $key = $_;
           $config{$key}->{conf} &&
              ( $config{$key}->{conf} eq 'ALL'
              || grep { $mode eq $_ } @{$config{$key}->{conf}} )
        } keys %config;

   my $key = prompt_list(
      "Enter the name of the variable you wish to configure",
      '',
      sub{ return keys %config_choices },
      \%config_choices);

   if ( exists($config_choices{$key}) ) {
      get_config_interactive($key);
   }
}

# get_expr {{{3
sub get_expr {
   my $exp;
   $clear_screen_sub->();
   print word_wrap("Choose the name of an expression to be used to calculate the column's contents.  "
      . "You can choose an existing expression, or type a new name to create a new one.");
   do {
      $exp = prompt_list(
         "Enter expression name",
         '',
         sub { return keys %exprs },
         { map { $_ => trunc(collapse_ws($exprs{$_}->{text}), 30) } keys %exprs },
         { sep => ' ' });
   } while ( !$exp );
   if ( !exists $exprs{$exp} ) {
      my ( $err, $sub, $body );
      do {
         $clear_screen_sub->();
         print word_wrap("The expression you named doesn't exist yet.  Specify a Perl expression for the body of "
               . "a subroutine that accepts a hashref called \$set and returns your desired value.");
         print "\n\n";
         if ( $err ) {
            print "There's an error in your expression: $err\n\n";
         }
         $body = prompt("Enter subroutine body");
         ( $sub, $err )  = compile_expr($body);
      } while ( $err );

      $exprs{$exp} = {
         func => $sub,
         text => $body,
         user => 1,
         name => $exp,
      };
   }
   return $exp;
}

# edit_color_rules {{{3
sub edit_color_rules {
   $clear_screen_sub->();
   my $tbl = choose_visible_table();
   if ( exists($tbl_meta{$tbl}) ) {
      my $meta = $tbl_meta{$tbl};
      my @cols = ('', qw(col op arg color));
      my $info = { map { $_ => { hdr => $_, just => '-', } }  @cols };
      $info->{label}->{maxw} = 30;
      my $key;
      my $selected_rule;

      # This loop builds a tabular view of the rules.
      do {

         # Show help
         if ( $key && $key eq '?' ) {
            my @display_lines = '';
            push @display_lines, create_caption('Editor key mappings',
            create_table2(
               [ sort keys %color_editor_action ],
               { map { $_ => $_ } keys %color_editor_action },
               { map { $_ => $color_editor_action{$_}->{note} } keys %color_editor_action },
               { sep => '  ' }));
            draw_screen(\@display_lines);
            pause();
            $key = '';
         }
         else {

            # Do the action specified
            $selected_rule ||= 0;
            if ( $key && $color_editor_action{$key} ) {
               $selected_rule = $color_editor_action{$key}->{func}->($tbl, $selected_rule);
               $selected_rule ||= 0;
            }

            # Build the table of rules.  If the terminal has color, the selected rule
            # will be highlighted; otherwise a > at the left will indicate.
            my $data = $meta->{colors} || [];
            foreach my $i ( 0..@$data - 1  ) {
               $data->[$i]->{''} = $i == $selected_rule ? '>' : '';
            }
            my @display_lines = create_table(\@cols, $info, $data);

            # Highlight selected entry
            for my $i ( 0 .. $#display_lines ) {
               if ( $display_lines[$i] =~ m/^>/ ) {
                  $display_lines[$i] = [ $display_lines[$i], 'reverse' ];
               }
            }

            # Draw the screen and wait for a command.
            unshift @display_lines, '',
               "Editing color rules for $meta->{hdr}.  Press ? for help, q to "
               . "quit.", '';
            draw_screen(\@display_lines);
            print "\n\n", word_wrap('Rules are applied in order from top to '
               . 'bottom.  The first matching rule wins and prevents the '
               . 'rest of the rules from being applied.');
            $key = pause('');
         }
      } while ( $key ne 'q' );
      $meta->{color_func} = make_color_func($meta);
   }
}

# edit_table {{{3
sub edit_table {
   $clear_screen_sub->();
   my $tbl = choose_visible_table();
   if ( exists($tbl_meta{$tbl}) ) {
      my $meta = $tbl_meta{$tbl};
      my @cols = ('', qw(name hdr label src expr));
      my $info = { map { $_ => { hdr => $_, just => '-', } }  @cols };
      $info->{label}->{maxw} = 30;
      my $key;
      my $selected_column;

      # This loop builds a tabular view of the tbl_meta's structure, showing each column
      # in the entry as a row.
      do {

         # Show help
         if ( $key && $key eq '?' ) {
            my @display_lines = '';
            push @display_lines, create_caption('Editor key mappings',
            create_table2(
               [ sort keys %tbl_editor_action ],
               { map { $_ => $_ } keys %tbl_editor_action },
               { map { $_ => $tbl_editor_action{$_}->{note} } keys %tbl_editor_action },
               { sep => '  ' }));
            draw_screen(\@display_lines);
            pause();
            $key = '';
         }
         else {

            # Do the action specified
            $selected_column ||= $meta->{visible}->[0];
            if ( $key && $tbl_editor_action{$key} ) {
               $selected_column = $tbl_editor_action{$key}->{func}->($tbl, $selected_column);
               $selected_column ||= $meta->{visible}->[0];
            }

            # Build the pivoted view of the table's meta-data.  If the terminal has color,
            # The selected row will be highlighted; otherwise a > at the left will indicate.
            my $data = [];
            foreach my $row ( @{$meta->{visible}} ) {
               my %hash;
               @hash{ @cols } = @{$meta->{cols}->{$row}}{@cols};
               $hash{src}  = '' if ref $hash{src};
               $hash{name} = $row;
               $hash{''}   = $row eq $selected_column ? '>' : ' ';
               push @$data, \%hash;
            }
            my @display_lines = create_table(\@cols, $info, $data);

            # Highlight selected entry
            for my $i ( 0 .. $#display_lines ) {
               if ( $display_lines[$i] =~ m/^>/ ) {
                  $display_lines[$i] = [ $display_lines[$i], 'reverse' ];
               }
            }

            # Draw the screen and wait for a command.
            unshift @display_lines, '',
               "Editing table definition for $meta->{hdr}.  Press ? for help, q to quit.", '';
            draw_screen(\@display_lines);
            $key = pause('');
         }
      } while ( $key ne 'q' );
   }
}

# choose_mode_tables {{{3
# Choose which table(s), and in what order, to display in a given mode.
sub choose_mode_tables {
   my $mode = $config{mode}->{val};
   my @tbls = @{$modes{$mode}->{visible_tables}};
   my $new  = prompt_list(
      "Choose tables to display",
      join(' ', @tbls),
      sub { return @{$modes{$mode}->{tables}} },
      { map { $_ => $tbl_meta{$_}->{hdr} } @{$modes{$mode}->{tables}} }
   );
   $modes{$mode}->{visible_tables} =
      [ unique(grep { $_ && exists $tbl_meta{$_} } split(/\s+/, $new)) ];
}

# choose_visible_table {{{3
sub choose_visible_table {
   my $mode = $config{mode}->{val};
   my @tbls = @{$modes{$mode}->{visible_tables}};
   my $tbl = $tbls[0];
   if ( @tbls > 1 ) {
      $tbl = prompt_list(
         "Choose a table",
         '',
         sub { return @tbls },
         { map { $_ => $tbl_meta{$_}->{hdr} } @tbls }
      );
   }
   return $tbl;
}

sub choose_sort_cols {
   $clear_screen_sub->();
   my $tbl = shift;
   return unless $tbl && exists $tbl_meta{$tbl};
   my $meta = $tbl_meta{$tbl};
   my $val = prompt_list(
      'Choose sort columns (prefix a column with - to reverse sort)',
      $meta->{sort_cols},
      sub { return keys %{$meta->{cols}} },
      { map { $_ => $meta->{cols}->{$_}->{label} } keys %{$meta->{cols}} });
   $meta->{sort_cols} = $val;
   $tbl_meta{$tbl}->{sort_func} = make_sort_func($tbl_meta{$tbl});
}

# create_new_filter {{{3
sub create_new_filter {
   my ( $filter, $tbl ) = @_;
   $clear_screen_sub->();

   if ( !$filter || $filter =~ m/\W/ ) {
      print word_wrap("Choose a name for the filter.  This name is not displayed, and is only used "
            . "for internal reference.  It can only contain lowercase letters, numbers, and underscores.");
      print "\n\n";
      do {
         $filter = prompt("Enter filter name");
      } while ( !$filter || $filter =~ m/\W/ );
   }

   my ( $err, $sub, $body );
   do {
      $clear_screen_sub->();
      print word_wrap("A filter is a Perl subroutine that accepts a hashref of columns "
         . "called \$set, and returns a true value if the filter accepts the row.  Example:\n"
         . "   \$set->{active_secs} > 5\n"
         . "will only allow rows if their active_secs column is greater than 5.");
      print "\n\n";
      if ( $err ) {
         print "There's an error in your filter expression: $err\n\n";
      }
      $body = prompt("Enter subroutine body");
      ( $sub, $err ) = compile_filter($body);
   } while ( $err );

   $filters{$filter} = {
      func => $sub,
      text => $body,
      user => 1,
      name => $filter,
      note => 'User-defined filter',
      tbls => [$tbl],
   };
}

# get_config_interactive {{{3
sub get_config_interactive {
   my $key = shift;
   $clear_screen_sub->();

   # Print help first.
   print "Enter a new value for '$key' ($config{$key}->{note}).\n";

   my $current = ref($config{$key}->{val}) ? join(" ", @{$config{$key}->{val}}) : $config{$key}->{val};

   my $new_value = prompt('Enter a value', $config{$key}->{pat}, $current);
   $config{$key}->{val} = $new_value;
}

# TODO: make a list of all variables and what they come from.  Use that for
# auto-completion here and in add_new_var_set, and for figuring out what data is needed.
# Cache the list of what data is needed.
sub edit_current_var_set {
   my $mode = $config{mode}->{val};
   my $name = $config{"${mode}_set"}->{val};
   my $variables = join(' ', @{$var_sets{$name}});

   do {
      $clear_screen_sub->();
      $variables = prompt("Enter variables for $name", undef, $variables );
   } until ( $variables );

   $var_sets{$name} = [ unique(grep { $_ } split(/\s+/, $variables)) ];
}


sub choose_var_set {
   my $key = shift;
   $clear_screen_sub->();

   my $new_value = prompt_list(
      'Choose a set of values to display, or enter the name of a new one',
      $config{$key}->{val},
      sub { return keys %var_sets },
      { map { $_ => join(' ', @{$var_sets{$_}}) } sort keys %var_sets });

   if ( !exists $var_sets{$new_value} ) {
      add_new_var_set($new_value);
   }

   $config{$key}->{val} = $new_value if exists $var_sets{$new_value};
}


# get_file {{{3
sub get_file {
   my $filename = shift;
   open my $file, "<", "$filename" or die "Can't open $filename: $!";
   my $file_contents = do { local $/; <$file>; };
   close $file;
   return $file_contents;
}

# filename {{{3
sub filename {
   ( my $filename = shift ) =~ s#^.*[/\\]##;
   return $filename;
}

# Online configuration and prompting functions {{{2

# edit_server_groups {{{3
# Choose which server connections are in a server group.  First choose a group,
# then choose which connections are in it.
sub edit_server_groups {
   $clear_screen_sub->();
   my $mode  = $config{mode}->{val};
   my $group = $modes{$mode}->{server_group};
   my %curr  = %server_groups;
   my $new   = choose_or_create_server_group($group, 'to edit');
   my $cxns  = join(' ', @{$server_groups{$new}});
   $clear_screen_sub->();
   if ( exists $curr{$new} ) {
      # Don't do this step if the user just created a new server group,
      # because part of that process was to choose connections.
      my @conns = choose_or_create_connection($cxns, 'for this group');
      $server_groups{$new} = \@conns;
   }
}

# choose_server_groups {{{3
sub choose_server_groups {
   $clear_screen_sub->();
   my $mode  = $config{mode}->{val};
   my $group = $modes{$mode}->{server_group};
   my $new   = choose_or_create_server_group($group, 'for this mode');
   $modes{$mode}->{server_group} = $new if exists $server_groups{$new};
}

sub choose_or_create_server_group {
   my ( $group, $prompt ) = @_;
   my $new   = '';

   my @available = sort keys %server_groups;

   if ( @available ) {
      print "You can enter the name of a new group to create it.\n";

      $new = prompt_list(
         "Choose a server group $prompt",
         $group,
         sub { return @available },
         { map { $_ => join(' ', @{$server_groups{$_}}) } @available });

      $new =~ s/\s.*//;

      if ( !exists $server_groups{$new} ) {
         my $answer = prompt("There is no server group called '$new'.  Create it?", undef, "y");
         if ( $answer eq 'y' ) {
            add_new_server_group($new);
         }
      }
   }
   else {
      $new = add_new_server_group();
   }
   return $new;
}

sub choose_or_create_connection {
   my ( $cxns, $prompt ) = @_;
   print "You can enter the name of a new connection to create it.\n";

   my @available = sort keys %connections;
   my $new_cxns = prompt_list(
      "Choose connections $prompt",
      $cxns,
      sub { return @available },
      { map { $_ => $connections{$_}->{dsn} } @available });

   my @new = unique(grep { !exists $connections{$_} } split(/\s+/, $new_cxns));
   foreach my $new ( @new ) {
      my $answer = prompt("There is no connection called '$new'.  Create it?", undef, "y");
      if ( $answer eq 'y' ) {
         add_new_dsn($new);
      }
   }

   return unique(grep { exists $connections{$_} } split(/\s+/, $new_cxns));
}

# choose_servers {{{3
sub choose_servers {
   $clear_screen_sub->();
   my $mode = $config{mode}->{val};
   my $cxns = join(' ', get_connections());
   my @chosen = choose_or_create_connection($cxns, 'for this mode');
   $modes{$mode}->{connections} = \@chosen;
   $modes{$mode}->{server_group} = ''; # Clear this because it overrides {connections}
}

# display_license {{{3
sub display_license {
   $clear_screen_sub->();

   print $innotop_license;

   pause();
}

# Data-retrieval functions {{{2
# get_status_info {{{3
# Get SHOW STATUS and SHOW VARIABLES together.
# TODO: figure out how to only get the needed parts.  Maybe split status/vars into two subs.
sub get_status_info {
   my @cxns = @_;
   if ( !$info_gotten{status}++ ) {
      foreach my $cxn ( @cxns ) {
         $vars{$cxn}->{$clock} ||= {};
         my $vars = $vars{$cxn}->{$clock};

         my $sth = do_stmt($cxn, 'SHOW_STATUS') or next;
         my $res = $sth->fetchall_arrayref();
         map { $vars->{$_->[0]} = $_->[1] || 0 } @$res;

         # Calculate hi-res uptime and add cxn to the hash
         $vars->{Uptime_hires} ||= $hi_res ? time() - $dbhs{$cxn}->{start_time} : $vars->{Uptime};
         $vars->{cxn} = $cxn;

         # Add SHOW VARIABLES to the hash
         $sth = do_stmt($cxn, 'SHOW_VARIABLES') or next;
         $res = $sth->fetchall_arrayref();
         map { $vars->{$_->[0]} = $_->[1] || 0 } @$res;
      }
   }
}

# analyze_query {{{3
# Allows the user to show fulltext, explain, show optimized...
sub analyze_query {
   my $action = shift;
   my %actions = (
      e => \&display_explain,
      f => \&show_full_query,
      o => \&show_optimized_query,
   );

   # Find out which server.
   my @cxns = unique map { $_->{cxn} } @current_queries;
   my ( $cxn ) = select_cxn('On which server', @cxns);
   return unless $cxn && exists($connections{$cxn});

   # Find out which connection.
   my @ids = sort map { $_->{id} } grep { $_->{cxn} eq $cxn } @current_queries;
   return unless @ids;
   my $id = prompt_list('Specify a connection ID to analyze',
      $ids[0],
      sub { return @ids });

   # Find the info hash of that query on that server.
   my ( $info ) = grep { $cxn eq $_->{cxn} && $id == $_->{id} } @current_queries;
   return unless $info;

   do {
      $actions{$action}->($info);
      print "\n";
      $action = pause('Press e to explain, f for full query, o for optimized query');
   } while ( exists($actions{$action}) );
}

# inc {{{3
# Returns the difference between two sets of variables/status/innodb stuff.
sub inc {
   my ( $offset, $cxn ) = @_;
   my $vars = $vars{$cxn};
   if ( $offset < 0 ) {
      return $vars->{$clock};
   }
   elsif ( exists $vars{$clock - $offset} && !exists $vars->{$clock - $offset - 1} ) {
      return $vars->{$clock - $offset};
   }
   my $cur = $vars->{$clock - $offset};
   my $pre = $vars->{$clock - $offset - 1};
   return {
      # Numeric variables get subtracted, non-numeric get passed straight through.
      map  {
         $_ =>
            ( (defined $cur->{$_} && $cur->{$_} =~ m/$num_regex/)
            ?  $cur->{$_} - ($pre->{$_} || 0)
            :  $cur->{$_} )
      } keys %{$cur}
   };
}

# extract_values {{{3
sub extract_values {
   my ( $set, $tbl ) = @_;
   my $result = {};
   my $meta   = $tbl_meta{$tbl};
   my $cols   = $meta->{cols};
   foreach my $key ( keys %$cols ) {
      my $info = $cols->{$key}
         or die "Column '$key' doesn't exist in $tbl";
      die "No func defined for '$key' in $tbl"
         unless $info->{func};
      eval {
         $result->{$key} = $info->{func}->($set)
      };
      if ( $EVAL_ERROR ) {
         $result->{$key} = $info->{num} ? 0 : '';
      }
   }
   return $result;
}

# get_full_processlist {{{3
sub get_full_processlist {
   my @cxns = @_;
   my @result;
   foreach my $cxn ( @cxns ) {
      my $stmt = do_stmt($cxn, 'PROCESSLIST') or next;
      my $arr  = $stmt->fetchall_arrayref({});
      push @result, map { $_->{cxn} = $cxn; $_ } @$arr;
   }
   return @result;
}

# get_open_tables {{{3
sub get_open_tables {
   my @cxns = @_;
   my @result;
   foreach my $cxn ( @cxns ) {
      my $stmt = do_stmt($cxn, 'OPEN_TABLES') or next;
      my $arr  = $stmt->fetchall_arrayref({});
      push @result, map { $_->{cxn} = $cxn; $_ } @$arr;
   }
   return @result;
}

# get_innodb_status {{{3
sub get_innodb_status {
   my ( $cxns, $addl_sections ) = @_;
   if ( !$info_gotten{innodb_status}++ ) {
      my $parser = InnoDBParser->new;

      # Determine which sections need to be parsed
      my %sections_required =
         map  { $tbl_meta{$_}->{innodb} => 1 }
         grep { $_ }
         get_visible_tables();

      # Add in any other sections the caller requested.
      foreach my $sec ( @$addl_sections ) {
         $sections_required{$sec} = 1;
      }

      foreach my $cxn ( @$cxns ) {
         my $stmt = do_stmt($cxn, 'INNODB_STATUS') or next;
         my $innodb_status_text = $stmt->fetchrow_hashref()->{Status};

         # Parse and merge into %vars storage
         my %innodb_status = (
            $parser->get_status_hash(
               $innodb_status_text,
               $config{debug}->{val},
               \%sections_required,
               0, # don't parse full lock information
            )
         );
         if ( !$innodb_status{IB_got_all} && $config{auto_wipe_dl}->{val} ) {
            clear_deadlock($cxn);
         }

         # Merge using a hash slice, which is the fastest way
         $vars{$cxn}->{$clock} ||= {};
         my $hash = $vars{$cxn}->{$clock};
         @{$hash}{ keys %innodb_status } = values %innodb_status;
         $hash->{cxn} = $cxn;
         $hash->{Uptime_hires} ||= $hi_res ? time() - $dbhs{$cxn}->{start_time} : $hash->{Uptime};
      }
   }
}

# clear_deadlock {{{3
sub clear_deadlock {
   my ( $cxn ) = @_;
   return if $clearing_deadlocks++;
   my $tbl = $connections{$cxn}->{dl_table};
   return unless $tbl;

   eval {
      # Set up the table for creating a deadlock.
      return unless do_query($cxn, "drop table if exists $tbl");
      return unless do_query($cxn, "create table $tbl(a int) engine=innodb");
      return unless do_query($cxn, "delete from $tbl");
      return unless do_query($cxn, "insert into $tbl(a) values(0), (1)");
      return unless do_query($cxn, "commit"); # Or the children will block against the parent

      # Fork off two children to deadlock against each other.
      my %children;
      foreach my $child ( 0..1 ) {
         my $pid = fork();
         if ( defined($pid) && $pid == 0 ) { # I am a child
            deadlock_thread( $child, $tbl, $cxn );
         }
         elsif ( !defined($pid) ) {
            die("Unable to fork for clearing deadlocks!\n");
         }
         # I already exited if I'm a child, so I'm the parent.
         $children{$child} = $pid;
      }

      # Wait for the children to exit.
      foreach my $child ( keys %children ) {
         my $pid = waitpid($children{$child}, 0);
      }

      # Clean up.
      do_query($cxn, "drop table $tbl");
   };
   if ( $EVAL_ERROR ) {
      print $EVAL_ERROR;
   }

   $clearing_deadlocks = 0;
}

# get_master_slave_status {{{3
# TODO: apparently in version 4 the column names are different?
# TODO: split into master/slave status...
sub get_master_slave_status {
   my @cxns = @_;
   if ( !$info_gotten{replication_status}++ ) {
      foreach my $cxn ( @cxns ) {
         $vars{$cxn}->{$clock} ||= {};
         my $vars = $vars{$cxn}->{$clock};
         $vars->{cxn} = $cxn;

         my $stmt = do_stmt($cxn, 'SHOW_MASTER_STATUS') or next;
         my $res = $stmt->fetchall_arrayref({})->[0];
         @{$vars}{ keys %$res } = values %$res;
         $stmt = do_stmt($cxn, 'SHOW_SLAVE_STATUS') or next;
         $res = $stmt->fetchall_arrayref({})->[0];
         @{$vars}{ keys %$res } = values %$res;
         $vars->{Uptime_hires} ||= $hi_res ? time() - $dbhs{$cxn}->{start_time} : $vars->{Uptime};
      }
   }
}

# Documentation {{{1
# ############################################################################
# I put this last as per the Dog book.
# ############################################################################
=pod

=head1 NAME

innotop - A MySQL and InnoDB monitor program.

=head1 DESCRIPTION

innotop connects to one or many MySQL database servers and retrieves data, then
displays it.  It can run interactively as a monitor, or serve as a source for
UNIX pipe-and-filter style programming.  innotop uses the data from SHOW
VARIABLES, SHOW GLOBAL STATUS, SHOW FULL PROCESSLIST, and SHOW ENGINE INNODB
STATUS, among other things.  It refreshes the data at regular intervals, so you
get a sense of what's happening inside your MySQL servers.  You can control how
fast it refreshes.

I originally wrote innotop to parse SHOW INNODB STATUS and show a list of
current transactions in `top' style, hence the name.  It now has much more
functionality.

When innotop is running interactively, you control it with key presses.  You can
find a complete list of all available keys at any time by pressing '?' for help.
Keys change innotop from one mode to another, let you change configuration, and
send commands to MySQL servers.

=head1 OVERVIEW

Within each of innotop's modes, innotop displays 'tables' of the current data.
For example, in T (InnoDB Transactions) mode, it shows the transactions in a
table.  In some modes there are many tables on screen at once.

You can choose which tables to display, in what order, which columns and in what
order, how to sort the rows, colorize and filter the rows, and more.  Think of
the tables as spreadsheets; you have quite a bit of control over what goes into
the cells.  You can even define your own formulas and apply formatting.  For
example, you can choose whether a cell should be right or left justified,
specify minimum and maximum widths, shorten large numbers to familiar units like
MB and GB, and turn an integer number of seconds into hours:minutes:seconds
display.

Some modes allow you to see the incremental changes since last refresh.  This
can be useful to see how many new queries have been issued during that time, for
example.  You can toggle this on and off.

You can define many connections to servers, group the servers together, and
switch between them easily to manage many MySQL instances conveniently.  See
SERVER GROUPS for more.

Remember, press '?' to see what commands are available to you at any time.

=head1 CONFIGURATION

innotop is completely configurable.  The default configuration is built into the
program, but everything is written out to a configuration file when you exit
innotop.  You can edit this file by hand as you wish, or just use the built-in
configuration commands while innotop is running.

You can specify certain options on the command-line.  Run `innotop --help' for
details.

=head1 MODES

innotop has many modes.  The following is a brief description of each in
alphabetical order.  Remember, you can always get the authoritative help by
pressing '?'.

=over 8

=item B: InnoDB Buffers

This mode displays the InnoDB buffer pool, page statistics, insert buffer, and
adaptive hash index.

=item D: InnoDB Deadlocks

This mode shows the transactions involved in the last InnoDB deadlock.  A second
table shows the locks each transaction held and waited for (recall that a
deadlock is caused by a cycle in the waits-for graph).

InnoDB puts deadlock information before some other information in the SHOW
INNODB STATUS output.  If there are a lot of locks, the deadlock information can
grow very large indeed, and there is a limit on the size of the SHOW INNODB
STATUS output.  A large deadlock can fill the entire output, or even be
truncated, and prevent you from seeing other information at all.  If you are
running innotop in another mode, for example T mode, and suddenly you don't see
anything, you might want to check and see if a deadlock has wiped out the data
you need.

If it has, you can create a small deadlock to replace it.  Use the 'w' key to
'wipe' the large deadlock with a small one.  This will not work unless you have
defined a deadlock table for the connection -- look in your configuration file.

You can also set innotop to automatically detect when a large deadlock needs to
be replaced with a small one.  This feature is turned off by default.

=item F: InnoDB Foreign Key Errors

This mode shows the last InnoDB foreign key error information, such as the
table where it happened, when and who and what query caused it, and so on.

InnoDB has a huge variety of foreign key error messages, and many of them are
just hard to parse.  innotop doesn't always do the best job here, but there's
so much code devoted to parsing this messy, unparseable output that innotop is
likely never to be perfect in this regard.  If innotop doesn't show you what
you need to see, just look at the status text directly.

=item G: Load Graph

This mode calculates per-second statistics, such as queries per second, scales
them against a maximum, and prints them out as a "bar graph."  It's similar to
the Load Statistics mode, except it's a graph instead of numbers.

Headers are abbreviated to fit on the screen if necessary.  This only happens in
interactive operation, not while running unattended.

=item I: InnoDB I/O Info

This mode shows InnoDB's I/O statistics, including the I/O threads, pending
I/O, file I/O miscellaneous, and log statistics.

=item M: Master/Slave Replication Status

This mode shows the output of SHOW SLAVE STATUS and SHOW MASTER STATUS in three
tables.  The first two divide the slave's status into SQL and I/O thread status,
and the last shows master status.  Filters are applied to eliminate non-slave
servers from the slave tables and vice versa.

=item O: Open Tables

This section comes from MySQL's SHOW OPEN TABLES command.  By default it is
filtered to show tables which are in use by one or more queries, so you can
get a quick look at which tables are 'hot'.  You can use this to guess which
tables might be locked implicitly.

=item Q: Query List

This mode displays the output from SHOW FULL PROCESSLIST, much like B<mytop>'s
query list mode.  This mode does B<not> show InnoDB-related information.  This
is probably one of the most useful modes for general usage.

You can toggle an informative header that shows general status information about
your server.  There are default sorting, filtering, and colorization rules.

You can EXPLAIN a query from this mode.  This will allow you to see the query's
full text, the results of EXPLAIN, and in newer MySQL versions, even see the
optimized query resulting from EXPLAIN EXTENDED.

=item R: InnoDB Row Operations and Semaphores

This mode shows InnoDB row operations, row operation miscellaneous, semaphores,
and information from the wait array.

=item S: Load Statistics

This mode calculates statistics, such as queries per second, and prints them out
in the style of <vmstat>.  It's similar to the Load Graph mode, except it's a
numbers instead of a graph.  You can show absolute values or incremental values
since the last refresh.  Like G mode, headers may be abbreviated to fit on the
screen in interactive operation.  You choose which variables to display with the
'c' key, which selects from predefined sets.  You can choose your own sets.

=item T: InnoDB Transactions

This mode shows every transaction in the InnoDB monitor's output, in `top'
format.  This mode is the reason I wrote innotop.

By default, two filters are applied to the table to hide inactive transactions
and hide innotop's own transaction.  You can toggle this on and off.  There are
also default sort and colorization rules in this view.  You can customize these.

If you are only viewing one server's transactions, innotop can display an
informational header.  This will show you things like how many entries there are
in the InnoDB history list, how much of the buffer pool is used, and so forth.

=item V: Variables & Status

This mode displays any variables you please from SHOW GLOBAL STATUS and SHOW
VARIABLES, as well as the values parsed from SHOW INNODB STATUS.  It displays
not only the current values, but previous values too; you choose how many sets
to keep on screen.

=item W: InnoDB Lock Waits

This mode shows information about current InnoDB lock waits.  This information
comes from the TRANSACTIONS section of the InnoDB status text.  If you have a
very busy server, you may have frequent lock waits; it helps to be able to see
which tables and indexes are the "hot spot" for locks.  If your server is
running pretty well, this mode should show nothing.

A second table shows any waits in the OS wait array.  This comes from a separate
section of the status text.  If you see frequent waits, your server is probably
running under a high concurrency workload.  This is the same table displayed in
R mode.

=back

=head1 SERVER GROUPS

If you have a lot of MySQL instances, or even if you only have a few, you will
probably find this functionality helpful.

To begin with, when you start innotop it will prompt you to define a connection
to a server.  After that is done, you can tell it to monitor another server with
the @ key.  This key actually brings up a list of connections you've defined.
If you name one that doesn't exist, innotop will guide you through the process
of defining it as a new connection, and it will be available from then on.

You can name multiple connections in any mode.  For example, suppose you are in
T mode, monitoring transactions on server1; if you press @, you can type
'server1 server2' and see data from both.

This becomes unwieldy after a bit though.  To address this, you can press the
'#' key to create and select server groups.  Groups work just the same as
connections: if you name one that doesn't exist, you can create it.

As an example, you might have groups named 'all', 'masters', 'slaves', 'oltp'
and 'olap'.  Many of the servers could belong to several of these groups.  It's
just a quick way to toggle between various servers.

Once you have defined groups, you can press the TAB key to cycle between them.

As of this writing innotop does NOT fetch data in parallel from different
servers, so if your groups get large you may notice increased delay time when
innotop refreshes.  You can address this by creating more small groups.  At some
point I plan to make the data-fetching multi-threaded and this problem will not
be so severe.

=head1 SYSTEM REQUIREMENTS

You must connect to the DB server as a user who has the SUPER privilege for
many of the functions.  If you don't have the SUPER privilege, you may still
be able to run some functions.

I think everything you need to run innotop is distributed either with Perl, or
with innotop itself.  You need DBI and DBD::mysql.  You also need the
InnoDBParser module, and Term::ReadKey.  If you have Time::HiRes, innotop will
use it.  If you have Term::ANSIColor, innotop will use it to format headers more
readably and compactly.  (Under Microsoft Windows, you also need
Win32::Console::ANSI for terminal formatting codes to be honored).  If you
install Term::ReadLine, preferably Term::ReadLine::Gnu, you'll get nice
auto-completion support.

I run innotop on Gentoo GNU/Linux, Debian and Ubuntu, and I've had feedback from
people successfully running it on Red Hat, CentOS, Solaris, and Mac OSX.  I
don't see any reason why it won't work on other UNIX-ish operating systems, but
I don't know for sure.  It also runs on Windows under ActivePerl without
problem.

I have perl v5.8.8 installed, and I've had reports of it working on 5.8.5 but
I don't know about other versions.

I use innotop on MySQL version 4.1 and 5.0, and have heard of others using it
on these same versions and 5.1.

=head1 FILES

$HOMEDIR/.innotop is used to store configuration information.

=head1 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright (c) 2006 Baron Schwartz, baron at xaprb dot com.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

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, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.

Execute innotop and press '!' to see this information at any time.

=head1 AUTHOR

Baron Schwartz, baron at xaprb dot com.

=head1 BUGS

If you find any problems with innotop, please contact me.  Specifically, if
you find any problems with parsing the InnoDB monitor output, I would greatly
appreciate you sending me the full text of the monitor output that caused the
problem.

=cut
