#!/usr/bin/perl

# This is mk-query-profiler, a program to analyze MySQL workload.
# 
# This program is copyright (c) 2007 Baron Schwartz.
# 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.

use strict;
use warnings FATAL => 'all';

our $VERSION = '1.1.9';
our $DISTRIB = '1877';
our $SVN_REV = sprintf("%d", map { $_ || 0 } q$Revision: 1871 $ =~ m/(\d+)/g);

# ###########################################################################
# OptionParser package 1844
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package OptionParser;

use Getopt::Long;
use List::Util qw(max);
use English qw(-no_match_vars);

sub new {
   my ( $class, @opts ) = @_;
   my %key_seen;
   my %long_seen;
   my %key_for;
   my %defaults;
   my @mutex;
   my @atleast1;
   my %long_for;
   my %disables;
   my %copyfrom;
   unshift @opts,
      { s => 'help',    d => 'Show this help message' },
      { s => 'version', d => 'Output version information and exit' };
   foreach my $opt ( @opts ) {
      if ( ref $opt ) {
         my ( $long, $short ) = $opt->{s} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
         $opt->{k} = $short || $long;
         $key_for{$long} = $opt->{k};
         $long_for{$opt->{k}} = $long;
         $long_for{$long} = $long;
         $opt->{l} = $long;
         die "Duplicate option $opt->{k}" if $key_seen{$opt->{k}}++;
         die "Duplicate long option $opt->{l}" if $long_seen{$opt->{l}}++;
         $opt->{t} = $short;
         $opt->{n} = $opt->{s} =~ m/!/;
         $opt->{g} ||= 'o';
         if ( (my ($y) = $opt->{s} =~ m/=([mdHhAaz])/) ) {
            $ENV{MKDEBUG} && _d("Option $opt->{k} type: $y");
            $opt->{y} = $y;
            $opt->{s} =~ s/=./=s/;
         }
         if ( $opt->{d} =~ m/required/ ) {
            $opt->{r} = 1;
            $ENV{MKDEBUG} && _d("Option $opt->{k} is required");
         }
         if ( (my ($def) = $opt->{d} =~ m/default\b(?: ([^)]+))?/) ) {
            $defaults{$opt->{k}} = defined $def ? $def : 1;
            $ENV{MKDEBUG} && _d("Option $opt->{k} has a default");
         }
         if ( (my ($dis) = $opt->{d} =~ m/(disables .*)/) ) {
            $disables{$opt->{k}} = [ $class->get_participants($dis) ];
            $ENV{MKDEBUG} && _d("Option $opt->{k} $dis");
         }
      }
      else { # It's an instruction.

         if ( $opt =~ m/at least one|mutually exclusive|one and only one/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $long_for{$_};
               } $class->get_participants($opt);
            if ( $opt =~ m/mutually exclusive|one and only one/ ) {
               push @mutex, \@participants;
               $ENV{MKDEBUG} && _d(@participants, ' are mutually exclusive');
            }
            if ( $opt =~ m/at least one|one and only one/ ) {
               push @atleast1, \@participants;
               $ENV{MKDEBUG} && _d(@participants, ' require at least one');
            }
         }
         elsif ( $opt =~ m/default to/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $key_for{$_};
               } $class->get_participants($opt);
            $copyfrom{$participants[0]} = $participants[1];
            $ENV{MKDEBUG} && _d(@participants, ' copy from each other');
         }

      }
   }

   if ( $ENV{MKDEBUG} ) {
      my $text = do {
         local $RS = undef;
         open my $fh, "<", $PROGRAM_NAME
            or die "Can't open $PROGRAM_NAME: $OS_ERROR";
         <$fh>;
      };
      my %used = map { $_ => 1 } $text =~ m/\$opts\{'?([\w-]+)'?\}/g;
      my @unused;
      my @undefined;
      my %option_exists;
      foreach my $opt ( @opts ) {
         next unless ref $opt;
         my $key = $opt->{k};
         $option_exists{$key}++;
         next if $opt->{l} =~ m/^(?:help|version|defaults-file|database|charset
                                    |password|port|socket|user|host)$/x
              || $disables{$key};
         push @unused, $key unless $used{$key};
      }
      foreach my $key ( keys %used ) {
         push @undefined, $key unless $option_exists{$key};
      }
      if ( @unused || @undefined ) {
         die "The following command-line options are unused: "
            . join(',', @unused)
            . ' The following are undefined: '
            . join(',', @undefined);
      }
   }

   foreach my $dis ( keys %disables ) {
      $disables{$dis} = [ map {
            die "No such option '$_' while processing $dis" unless $long_for{$_};
            $long_for{$_};
         } @{$disables{$dis}} ];
   }

   return bless {
      specs => [ grep { ref $_ } @opts ],
      notes => [],
      instr => [ grep { !ref $_ } @opts ],
      mutex => \@mutex,
      defaults => \%defaults,
      long_for => \%long_for,
      atleast1 => \@atleast1,
      disables => \%disables,
      key_for  => \%key_for,
      copyfrom => \%copyfrom,
      strict   => 1,
      groups   => [ { k => 'o', d => 'Options' } ],
   }, $class;
}

sub get_participants {
   my ( $self, $str ) = @_;
   my @participants;
   foreach my $thing ( $str =~ m/(--?[\w-]+)/g ) {
      if ( (my ($long) = $thing =~ m/--(.+)/) ) {
         push @participants, $long;
      }
      else {
         foreach my $short ( $thing =~ m/([^-])/g ) {
            push @participants, $short;
         }
      }
   }
   $ENV{MKDEBUG} && _d("Participants for $str: ", @participants);
   return @participants;
}

sub parse {
   my ( $self, %defaults ) = @_;
   my @specs = @{$self->{specs}};
   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);

   my %opt_seen;
   my %vals = %{$self->{defaults}};
   @vals{keys %defaults} = values %defaults;
   foreach my $spec ( @specs ) {
      $vals{$spec->{k}} = undef unless defined $vals{$spec->{k}};
      $opt_seen{$spec->{k}} = 1;
   }

   foreach my $key ( keys %defaults ) {
      die "Cannot set default for non-existent option '$key'\n"
         unless $opt_seen{$key};
   }

   Getopt::Long::Configure('no_ignore_case', 'bundling');
   GetOptions( map { $_->{s} => \$vals{$_->{k}} } @specs )
      or $self->error('Error parsing options');

   if ( $vals{version} ) {
      my $prog = $self->prog;
      printf("%s  Ver %s Distrib %s Changeset %s\n",
         $prog, $main::VERSION, $main::DISTRIB, $main::SVN_REV);
      exit(0);
   }

   if ( @ARGV && $self->{strict} ) {
      $self->error("Unrecognized command-line options @ARGV");
   }

   foreach my $dis ( grep { defined $vals{$_} } keys %{$self->{disables}} ) {
      my @disses = map { $self->{key_for}->{$_} } @{$self->{disables}->{$dis}};
      $ENV{MKDEBUG} && _d("Unsetting options: ", @disses);
      @vals{@disses} = map { undef } @disses;
   }

   foreach my $spec ( grep { $_->{r} } @specs ) {
      if ( !defined $vals{$spec->{k}} ) {
         $self->error("Required option --$spec->{l} must be specified");
      }
   }

   foreach my $mutex ( @{$self->{mutex}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$mutex;
      if ( @set > 1 ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$mutex}[ 0 .. scalar(@$mutex) - 2] );
         $note .= " and --$self->{long_for}->{$mutex->[-1]}"
               . " are mutually exclusive.";
         $self->error($note);
      }
   }

   foreach my $required ( @{$self->{atleast1}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$required;
      if ( !@set ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$required}[ 0 .. scalar(@$required) - 2] );
         $note .= " or --$self->{long_for}->{$required->[-1]}";
         $self->error("Specify at least one of $note");
      }
   }

   foreach my $spec ( grep { $_->{y} && defined $vals{$_->{k}} } @specs ) {
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'm' ) {
         my ( $num, $suffix ) = $val =~ m/(\d+)([a-z])?$/;
         if ( !$suffix ) {
            my ( $s ) = $spec->{d} =~ m/\(suffix (.)\)/;
            $suffix = $s || 's';
            $ENV{MKDEBUG} && _d("No suffix given; using $suffix for $spec->{k} "
               . "(value: '$val')");
         }
         if ( $suffix =~ m/[smhd]/ ) {
            $val = $suffix eq 's' ? $num            # Seconds
                 : $suffix eq 'm' ? $num * 60       # Minutes
                 : $suffix eq 'h' ? $num * 3600     # Hours
                 :                  $num * 86400;   # Days
            $vals{$spec->{k}} = $val;
            $ENV{MKDEBUG} && _d("Setting option $spec->{k} to $val");
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
      elsif ( $spec->{y} eq 'd' ) {
         $ENV{MKDEBUG} && _d("Parsing option $spec->{y} as a DSN");
         my $from_key = $self->{copyfrom}->{$spec->{k}};
         my $default = {};
         if ( $from_key ) {
            $ENV{MKDEBUG} && _d("Option $spec->{y} DSN copies from option $from_key");
            $default = $self->{dsn}->parse($self->{dsn}->as_string($vals{$from_key}));
         }
         $vals{$spec->{k}} = $self->{dsn}->parse($val, $default);
      }
      elsif ( $spec->{y} eq 'z' ) {
         my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
         if ( defined $num ) {
            if ( $factor ) {
               $num *= $factor_for{$factor};
               $ENV{MKDEBUG} && _d("Setting option $spec->{y} to num * factor");
            }
            $vals{$spec->{k}} = ($pre || '') . $num;
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
   }

   foreach my $spec ( grep { $_->{y} } @specs ) {
      $ENV{MKDEBUG} && _d("Treating option $spec->{k} as a list");
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'H' || (defined $val && $spec->{y} eq 'h') ) {
         $vals{$spec->{k}} = { map { $_ => 1 } split(',', ($val || '')) };
      }
      elsif ( $spec->{y} eq 'A' || (defined $val && $spec->{y} eq 'a') ) {
         $vals{$spec->{k}} = [ split(',', ($val || '')) ];
      }
   }

   return %vals;
}

sub error {
   my ( $self, $note ) = @_;
   $self->{__error__} = 1;
   push @{$self->{notes}}, $note;
}

sub prog {
   (my $prog) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
   return $prog || $PROGRAM_NAME;
}

sub prompt {
   my ( $self ) = @_;
   my $prog   = $self->prog;
   my $prompt = $self->{prompt} || '<options>';
   return "Usage: $prog $prompt\n";
}

sub descr {
   my ( $self ) = @_;
   my $prog = $self->prog;
   my $descr  = $prog . ' ' . ($self->{descr} || '')
          . "  For more details, please use the --help option, "
          . "or try 'perldoc $prog' for complete documentation.";
   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g);
   $descr =~ s/ +$//mg;
   return $descr;
}

sub usage_or_errors {
   my ( $self, %opts ) = @_;
   if ( $opts{help} ) {
      print $self->usage(%opts);
      exit(0);
   }
   elsif ( $self->{__error__} ) {
      print $self->errors();
      exit(0);
   }
}

sub errors {
   my ( $self ) = @_;
   my $usage = $self->prompt() . "\n";
   if ( (my @notes = @{$self->{notes}}) ) {
      $usage .= join("\n  * ", 'Errors in command-line arguments:', @notes) . "\n";
   }
   return $usage . "\n" . $self->descr();
}

sub usage {
   my ( $self, %vals ) = @_;
   my @specs = @{$self->{specs}};

   my $maxl = max(map { length($_->{l}) + ($_->{n} ? 4 : 0)} @specs);

   my $maxs = max(0,
      map { length($_->{l}) + ($_->{n} ? 4 : 0)}
      grep { $_->{t} } @specs);

   my $lcol = max($maxl, ($maxs + 3));
   my $rcol = 80 - $lcol - 6;
   my $rpad = ' ' x ( 80 - $rcol );

   $maxs = max($lcol - 3, $maxs);

   my $usage = $self->descr() . "\n" . $self->prompt();
   foreach my $g ( @{$self->{groups}} ) {
      $usage .= "\n$g->{d}:\n";
      foreach my $spec (
         sort { $a->{l} cmp $b->{l} } grep { $_->{g} eq $g->{k} } @specs )
      {
         my $long  = $spec->{n} ? "[no]$spec->{l}" : $spec->{l};
         my $short = $spec->{t};
         my $desc  = $spec->{d};
         if ( $spec->{y} && $spec->{y} eq 'm' ) {
            my ($s) = $desc =~ m/\(suffix (.)\)/;
            $s    ||= 's';
            $desc =~ s/\s+\(suffix .\)//;
            $desc .= ".  Optional suffix s=seconds, m=minutes, h=hours, "
                   . "d=days; if no suffix, $s is used.";
         }
         $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol})(?:\s+|$)/g);
         $desc =~ s/ +$//mg;
         if ( $short ) {
            $usage .= sprintf("  --%-${maxs}s -%s  %s\n", $long, $short, $desc);
         }
         else {
            $usage .= sprintf("  --%-${lcol}s  %s\n", $long, $desc);
         }
      }
   }

   if ( (my @instr = @{$self->{instr}}) ) {
      $usage .= join("\n", map { "  $_" } @instr) . "\n";
   }
   if ( $self->{dsn} ) {
      $usage .= "\n" . $self->{dsn}->usage();
   }
   $usage .= "\nOptions and values after processing arguments:\n";
   foreach my $spec ( sort { $a->{l} cmp $b->{l} } @specs ) {
      my $val   = $vals{$spec->{k}};
      my $type  = $spec->{y} || '';
      my $bool  = $spec->{s} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
      $val      = $bool                     ? ( $val ? 'TRUE' : 'FALSE' )
                : !defined $val             ? '(No value)'
                : $type eq 'd'              ? $self->{dsn}->as_string($val)
                : $type =~ m/H|h/           ? join(',', sort keys %$val)
                : $type =~ m/A|a/           ? join(',', @$val)
                :                             $val;
      $usage .= sprintf("  --%-${lcol}s  %s\n", $spec->{l}, $val);
   }
   return $usage;
}

sub prompt_noecho {
   shift @_ if ref $_[0] eq __PACKAGE__;
   my ( $prompt ) = @_;
   local $OUTPUT_AUTOFLUSH = 1;
   print $prompt;
   my $response;
   eval {
      require Term::ReadKey;
      Term::ReadKey::ReadMode('noecho');
      chomp($response = <STDIN>);
      Term::ReadKey::ReadMode('normal');
      print "\n";
   };
   if ( $EVAL_ERROR ) {
      die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR";
   }
   return $response;
}

sub groups {
   my ( $self, @groups ) = @_;
   push @{$self->{groups}}, @groups;
}

sub _d {
   my ( $line ) = (caller(0))[2];
   print "# OptionParser:$line $PID ", @_, "\n";
}

if ( $ENV{MKDEBUG} ) {
   print '# ', $^X, ' ', $], "\n";
   my $uname = `uname -a`;
   if ( $uname ) {
      $uname =~ s/\s+/ /g;
      print "# $uname\n";
   }
   printf("# %s  Ver %s Distrib %s Changeset %s line %d\n",
      $PROGRAM_NAME, ($main::VERSION || ''), ($main::DISTRIB || ''),
      ($main::SVN_REV || ''), __LINE__);
}

1;

# ###########################################################################
# End OptionParser package
# ###########################################################################

# ###########################################################################
# DSNParser package 1868
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package DSNParser;

use DBI;
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;
use English qw(-no_match_vars);

sub new {
   my ( $class, @opts ) = @_;
   my $self = {
      opts => {
         A => {
            desc => 'Default character set',
            dsn  => 'charset',
            copy => 1,
         },
         D => {
            desc => 'Database to use',
            dsn  => 'database',
            copy => 1,
         },
         F => {
            desc => 'Only read default options from the given file',
            dsn  => 'mysql_read_default_file',
            copy => 1,
         },
         h => {
            desc => 'Connect to host',
            dsn  => 'host',
            copy => 1,
         },
         p => {
            desc => 'Password to use when connecting',
            dsn  => 'password',
            copy => 1,
         },
         P => {
            desc => 'Port number to use for connection',
            dsn  => 'port',
            copy => 1,
         },
         S => {
            desc => 'Socket file to use for connection',
            dsn  => 'mysql_socket',
            copy => 1,
         },
         u => {
            desc => 'User for login if not current user',
            dsn  => 'user',
            copy => 1,
         },
      },
   };
   foreach my $opt ( @opts ) {
      $ENV{MKDEBUG} && _d('Adding extra property ' . $opt->{key});
      $self->{opts}->{$opt->{key}} = { desc => $opt->{desc}, copy => $opt->{copy} };
   }
   return bless $self, $class;
}

sub prop {
   my ( $self, $prop, $value ) = @_;
   if ( @_ > 2 ) {
      $ENV{MKDEBUG} && _d("Setting $prop property");
      $self->{$prop} = $value;
   }
   return $self->{$prop};
}

sub parse {
   my ( $self, $dsn, $prev, $defaults ) = @_;
   if ( !$dsn ) {
      $ENV{MKDEBUG} && _d('No DSN to parse');
      return;
   }
   $ENV{MKDEBUG} && _d("Parsing $dsn");
   $prev     ||= {};
   $defaults ||= {};
   my %vals;
   my %opts = %{$self->{opts}};
   if ( $dsn !~ m/=/ && (my $p = $self->prop('autokey')) ) {
      $ENV{MKDEBUG} && _d("Interpreting $dsn as $p=$dsn");
      $dsn = "$p=$dsn";
   }
   my %hash = map { m/^(.)=(.*)$/g } split(/,/, $dsn);
   foreach my $key ( keys %opts ) {
      $ENV{MKDEBUG} && _d("Finding value for $key");
      $vals{$key} = $hash{$key};
      if ( !defined $vals{$key} && defined $prev->{$key} && $opts{$key}->{copy} ) {
         $vals{$key} = $prev->{$key};
         $ENV{MKDEBUG} && _d("Copying value for $key from previous DSN");
      }
      if ( !defined $vals{$key} ) {
         $vals{$key} = $defaults->{$key};
         $ENV{MKDEBUG} && _d("Copying value for $key from defaults");
      }
   }
   foreach my $key ( keys %hash ) {
      die "Unrecognized DSN part '$key' in '$dsn'\n"
         unless exists $opts{$key};
   }
   if ( (my $required = $self->prop('required')) ) {
      foreach my $key ( keys %$required ) {
         die "Missing DSN part '$key' in '$dsn'\n" unless $vals{$key};
      }
   }
   return \%vals;
}

sub as_string {
   my ( $self, $dsn ) = @_;
   return $dsn unless ref $dsn;
   return join(',',
      map  { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) }
      grep { defined $dsn->{$_} && $self->{opts}->{$_} }
      sort keys %$dsn );
}

sub usage {
   my ( $self ) = @_;
   my $usage
      = "DSN syntax is key=value[,key=value...]  Allowable DSN keys:\n"
      . "  KEY  COPY  MEANING\n"
      . "  ===  ====  =============================================\n";
   my %opts = %{$self->{opts}};
   foreach my $key ( sort keys %opts ) {
      $usage .= "  $key    "
             .  ($opts{$key}->{copy} ? 'yes   ' : 'no    ')
             .  ($opts{$key}->{desc} || '[No description]')
             . "\n";
   }
   if ( (my $key = $self->prop('autokey')) ) {
      $usage .= "  If the DSN is a bareword, the word is treated as the '$key' key.\n";
   }
   return $usage;
}

sub get_cxn_params {
   my ( $self, $info ) = @_;
   my $dsn;
   my %opts = %{$self->{opts}};
   my $driver = $self->prop('dbidriver') || '';
   if ( $driver eq 'Pg' ) {
      $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(h P));
   }
   else {
      $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(F h P S A))
         . ';mysql_read_default_group=mysql';
   }
   $ENV{MKDEBUG} && _d($dsn);
   return ($dsn, $info->{u}, $info->{p});
}

sub get_dbh {
   my ( $self, $cxn_string, $user, $pass, $opts ) = @_;
   $opts ||= {};
   my $defaults = {
      AutoCommit        => 0,
      RaiseError        => 1,
      PrintError        => 0,
      mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/ ? 1 : 0),
   };
   @{$defaults}{ keys %$opts } = values %$opts;
   $ENV{MKDEBUG} && _d($cxn_string, ' ', $user, ' ', $pass, ' {',
      join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ), '}');
   my $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
   if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
      my $sql = "/*!40101 SET NAMES $charset*/";
      $ENV{MKDEBUG} && _d("$dbh: $sql");
      $dbh->do($sql);
      $ENV{MKDEBUG} && _d('Enabling charset for STDOUT');
      if ( $charset eq 'utf8' ) {
         binmode(STDOUT, ':utf8')
            or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
      }
      else {
         binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
      }
   }
   my $setvars = $self->prop('setvars');
   if ( $setvars ) {
      my $sql = "SET $setvars";
      $ENV{MKDEBUG} && _d("$dbh: $sql");
      $dbh->do($sql);
   }
   $ENV{MKDEBUG} && _d('DBH info: ',
      $dbh,
      Dumper($dbh->selectrow_hashref(
         'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
      ' Connection info: ', ($dbh->{mysql_hostinfo} || 'undef'),
      ' Character set info: ',
      Dumper($dbh->selectall_arrayref(
         'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),
      ' $DBD::mysql::VERSION: ', $DBD::mysql::VERSION,
      ' $DBI::VERSION: ', $DBI::VERSION,
   );
   return $dbh;
}

sub get_hostname {
   my ( $self, $dbh ) = @_;
   if ( my ($host) = ($dbh->{mysql_hostinfo} || '') =~ m/^(\w+) via/ ) {
      return $host;
   }
   my ( $hostname, $one ) = $dbh->selectrow_array(
      'SELECT /*!50038 @@hostname, */ 1');
   return $hostname;
}

sub disconnect {
   my ( $self, $dbh ) = @_;
   $ENV{MKDEBUG} && $self->print_active_handles($dbh);
   $dbh->disconnect;
}

sub print_active_handles {
   my ( $self, $thing, $level ) = @_;
   $level ||= 0;
   printf("# Active %sh: %s %s %s\n", $thing->{Type}, "\t" x $level,
      $thing, ($thing->{Type} eq 'st' ? $thing->{Statement} || '' : ''));
   foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) {
      $self->print_active_handles->( $handle, $level + 1 );
   }
}

sub _d {
   my ( $line ) = (caller(0))[2];
   @_ = map { defined $_ ? $_ : 'undef' } @_;
   print "# DSNParser:$line $PID ", @_, "\n";
}

1;

# ###########################################################################
# End DSNParser package
# ###########################################################################

package main;

use English qw(-no_match_vars);
use List::Util qw(sum min max first);
use Time::HiRes qw(time);

$OUTPUT_AUTOFLUSH = 1;

use constant MAX_ULONG => 4294967295; # 2^32-1

# ############################################################################
# Get configuration information.
# ############################################################################

my @opt_spec = (
   { s => 'allowcache|a',  d => 'Enable query cache' },
   { s => 'askpass',       d => 'Prompt for password for connection' },
   { s => 'calibrate|c!',  d => "Try to compensate for SHOW STATUS (default)" },
   { s => 'charset|A=s',   d => 'Default character set' },
   { s => 'database|D=s',  d => 'Database to use' },
   { s => 'defaults-file|F=s', d => 'Only read mysql options from the given file' },
   { s => 'external|e',    d => 'Calibrate, then pause while an external program runs' },
   { s => 'flush|f+',      d => 'Flush tables.  Specify twice to do between every query' },
   { s => 'host|h=s',      d => 'Connect to host' },
   { s => 'innodb|i!',     d => "Show InnoDB statistics (default)" },
   { s => 'only|n=h',      d => "Only print separate stats for these queries (e.g. 1,5,7)" },
   { s => 'password|p=s',  d => 'Password to use when connecting' },
   { s => 'port|P=i',      d => 'Port number to use for connection' },
   { s => 'separate|s',    d => 'Print stats separately for each query' },
   { s => 'session!',      d => 'Use session-scoped SHOW VARIABLES and SHOW STATUS (default)' },
   { s => 'setvars=s',     d => 'Set these MySQL variables (default wait_timeout=10000)' },
   { s => 'socket|S=s',    d => 'Socket file to use for connection' },
   { s => 'tab|t',         d => 'Print tab-separated values (for a spreadsheet)' },
   { s => 'user|u=s',      d => 'User for login if not current user' },
   { s => 'verbose|v+',    d => 'Verbosity (specify multiple times for more detail; default 0)' },
   { s => 'verify|r',      d => 'Verify nothing else is accessing the server' },
);

my $dsn_parser = new DSNParser();
my $opt_parser = new OptionParser(@opt_spec);
$opt_parser->{prompt} = '<options> [FILE]...';
$opt_parser->{strict} = 0;
$opt_parser->{descr}
   = q{reads and executes queries, and prints statistics about }
   . q{MySQL server load.  Connection options are read from MySQL }
   . q{option files.  If FILE is given, queries are read and }
   . q{executed from the file(s).  With no FILE, or when FILE is -, }
   . q{read standard input.  If --external is specified, lines in }
   . q{FILE are executed by the shell.  You must specify - if no }
   . q{FILE and you want --external to read and execute from }
   . q{standard input.  Queries in FILE must be terminated with a }
   . q{semicolon and separated by a blank line.};
my %opts = $opt_parser->parse();
$dsn_parser->prop('setvars', $opts{setvars});

$opts{v} = min(2, $opts{v});

$opt_parser->usage_or_errors(%opts);

# Connect to the database
if ( !$opts{p} && $opts{askpass} ) {
   $opts{p} = OptionParser::prompt_noecho("Enter password: ");
}

my $dbh = $dsn_parser->get_dbh(
   $dsn_parser->get_cxn_params(\%opts), { AutoCommit => 1, } );

my $variables    = get_variables($dbh);
my $have_innodb  = $opts{i} && $variables->{have_innodb} eq 'YES' ? 1 : 0;
my $have_session = $opts{session} && version_ge($dbh, '5.0.2'); # SESSION status and InnoDB status values.
my $have_rowlock = version_ge($dbh, '5.0.3') && $have_innodb; # InnoDB row lock status.
my $have_last    = version_ge($dbh, '5.0.1') && !$opts{e};    # Last query cost according to optimizer.

# Configure the query cache
my $have_qcache = 0;
if ( $variables->{query_cache_size} ) {
   if ( $opts{a} || $opts{e} ) {
      $have_qcache = 1;
   }
   else {
      $dbh->do("SET SESSION query_cache_type = OFF");
   }
}

# Depending on the level of verbosity and the server version, summary and
# separate printouts will include different formats.
my $formats_for = {
   0 => [
      $have_last    ? qw( OPT_COST ) : qw(),
                      qw( TBL_IDX ),
      $have_qcache  ? qw( QCACHE )   : qw(),
   ],
   1 => [
      $have_last    ? qw( OPT_COST )       : qw(),
                      qw( TBL_IDX ),
      $have_qcache  ? qw( QCACHE )         : qw(),
      $have_innodb  ? qw( ROW_OPS_INNODB ) : qw( ROW_OPS ),
   ],
   2 => [
      $have_last    ? qw( OPT_COST )                         : qw(),
                      qw( TBL_IDX ),
      $have_qcache  ? qw( QCACHE )                           : qw(),
      $have_innodb  ? qw( ROW_OPS_INNODB )                   : qw( ROW_OPS ),
      $have_rowlock ? qw( ROW_LOCKS )                        : qw(),
      $have_innodb  ? qw( IO_OPS IO_INNODB INNODB_DATA_OPS ) : qw( IO_OPS ),
   ],
};

# Globals that'll get set by subroutines.  Used in formats, which is why they
# must be global.
my $ch                 = {};
my $qcost              = 0;
my $qcost_total        = 0;
my $qtime_total        = 0;
my $bytes_in_total     = 0;
my $bytes_out_total    = 0;
my $which_query        = 0;
my $query_time         = 0;
my $query_text         = '';
my $qcache_inval       = 0;
my $qcache_inval_total = 0;
my $hdr_type           = '';

# ############################################################################
# Get a baseline for how much SHOW STATUS costs.
# ############################################################################

# Every status variable this script cares about
my @important_vars = qw(
   Bytes_received Bytes_sent
   Com_commit Com_delete Com_delete_multi Com_insert Com_insert_select
   Com_replace Com_replace_select Com_select Com_update Com_update_multi
   Created_tmp_disk_tables Created_tmp_files Created_tmp_tables Handler_commit
   Handler_delete Handler_read_first Handler_read_key Handler_read_next
   Handler_read_prev Handler_read_rnd Handler_read_rnd_next Handler_update
   Handler_write Innodb_buffer_pool_pages_flushed
   Innodb_buffer_pool_read_ahead_rnd Innodb_buffer_pool_read_ahead_seq
   Innodb_buffer_pool_read_requests Innodb_buffer_pool_reads
   Innodb_buffer_pool_wait_free Innodb_buffer_pool_write_requests
   Innodb_data_fsyncs Innodb_data_read Innodb_data_reads Innodb_data_writes
   Innodb_data_written Innodb_dblwr_pages_written Innodb_dblwr_writes
   Innodb_log_waits Innodb_log_write_requests Innodb_log_writes
   Innodb_os_log_fsyncs Innodb_os_log_written Innodb_pages_created
   Innodb_pages_read Innodb_pages_written Innodb_row_lock_time
   Innodb_row_lock_waits Innodb_rows_deleted Innodb_rows_inserted
   Innodb_rows_read Innodb_rows_updated Key_read_requests Key_reads
   Key_write_requests Key_writes Last_query_cost Qcache_hits Qcache_inserts
   Qcache_lowmem_prunes Qcache_queries_in_cache Questions Select_full_join
   Select_full_range_join Select_range Select_range_check Select_scan
   Sort_merge_passes Sort_range Sort_rows Sort_scan Table_locks_immediate
   );

# SESSION status variables this script cares about.
my @session_vars
   = $have_session
   ? qw(
      Bytes_received Bytes_sent Com_commit
      Com_delete Com_delete_multi Com_insert Com_insert_select
      Com_replace Com_replace_select Com_select Com_update Com_update_multi
      Created_tmp_disk_tables Created_tmp_tables Handler_commit Handler_delete
      Handler_read_first Handler_read_key Handler_read_next Handler_read_prev
      Handler_read_rnd Handler_read_rnd_next Handler_update Handler_write
      Last_query_cost Select_full_join Select_full_range_join Select_range
      Select_range_check Select_scan Sort_merge_passes Sort_range Sort_rows
      Sort_scan
      )
   : qw();

# Status variables that may decrease (if monotonically increasing variables
# decrease, it means they wrapped over the max size of a ulong).
my %non_monotonic_vars = (
   Qcache_queries_in_cache => 1,
   Last_query_cost         => 1,
);

get_status_info($dbh); # Throwaway to prime caches after FLUSH
my $status_0 = get_status_info($dbh);
my $status_1 = get_status_info($dbh);

my $base = $opts{c}
   ? ( { map { $_ => $status_1->{$_} - $status_0->{$_} } @important_vars } )
   : ( { map { $_ => 0 } @important_vars } );

if ( $opts{r} ) {
   my $base_2 = $opts{c} ? $base
      : ( { map { $_ => $status_1->{$_} - $status_0->{$_} } @important_vars } );

   sleep(1);
   my $status_2 = get_status_info($dbh);
   my $base_3
      = { map { $_ => $status_2->{$_} - $status_1->{$_} } @session_vars };
   foreach my $key ( @session_vars ) {
      if ( $base_3->{$key} != $base_2->{$key} ) {
         print "Cost of observation changed: $key $base_3->{$key} $base_2->{$key}\n";
      }
   }
}

# ############################################################################
# The main work happens now.
# ############################################################################

# Get a baseline status.
my $sql_status_0 = get_status_info($dbh);
my @queries;

# ############################################################################
# Do the profiling.
# ############################################################################
my $have_flushed_tables = 0;

if ( $opts{e} ) { # An external process will issue queries
   if ( !@ARGV ) { # Don't read files or STDIN
      flush_tables($have_flushed_tables++);
      my $start = time();
      print "Press <ENTER> when the external program is finished";
      <STDIN>;
      my $end = time();
      # Hack the @queries variable by stuffing the external program's data in as a
      # hash reference just as though it had been a query in a file.
      push @queries, {
         text   => '[External program]',
         start  => $start,
         end    => $end,
         status => get_status_info($dbh),
      };
   }
   else {
      while ( my $line = <> ) { # Read from STDIN, or files named on cmdline
         chomp $line;
         next unless $line;

         flush_tables($have_flushed_tables++);
         my $start = time();
         print `$line`;
         my $end = time();
         push @queries, {
            text   => $line,
            start  => $start,
            end    => $end,
            status => get_status_info($dbh),
         };
      }
   }
}
else {
   local $INPUT_RECORD_SEPARATOR = ''; # read a paragraph at a time
   while ( my $line = <> ) { # Read from STDIN, or files named on cmdline
      chomp $line;
      next unless $line;
      $line =~ s/;\s*\z//xms; # Remove trailing whitespace/semicolon

      flush_tables($have_flushed_tables++);
      my $query = {
         text  => $line,
         start => time(),
      };
      # It appears to me that this actually fetches all the data over the wire,
      # which is what I want for purposes of counting bytes in and bytes out.
      $dbh->do( $line );
      $query->{end}    = time();
      $query->{status} = get_status_info($dbh);
      push @queries, $query;
   }
}

# ############################################################################
# Tab-separated output for a spreadsheet.
# ############################################################################
if ( $opts{t} ) {

   # Get a list of all the SHOW STATUS measurements.
   my @statuses = (
      $sql_status_0,
      ( map { $_->{status} } @queries ),
      get_status_info($dbh),
   );

   # Decide which variables to output.  If verbosity is 0, output only those
   # whose values are non-zero across the board.  If verbosity is greater,
   # output everything.
   my @variables = sort keys %$sql_status_0;
   if ( !$opts{v} ) {
      @variables = grep {
         # Discover whether there is a true value in any set.  A 'true' value
         # is one where the value isn't the same as the value for the same key
         # in the previous set.  The first (before) and last (calibrate) set
         # are excluded.
         my $var = $_;
         first { # first() terminates early, unlike grep()
            defined $statuses[$_]->{$var}
             && defined $statuses[$_ - 1]->{$var}
             && $statuses[$_]->{$var} != $statuses[$_ - 1]->{$var}
         } ( 1 .. $#statuses - 1 );
      } @variables;
   }

   # Print headers.
   print
      join("\t",
         'Variable_name',
         'Before',
         ( map { "After$_" } ( 1 ..  $#statuses - 1 ) ),
         'Calibration',
      ),
      "\n";

   # Print each variable in tab-separated values.
   foreach my $key ( @variables ) {
      print
         join("\t", $key, map { defined($_->{$key}) ? $_->{$key} : '' } @statuses),
         "\n";
   }
}

# ############################################################################
# Tabular layout for human readability.
# ############################################################################
else {
   # Print the separate results and accumulate global totals.
   foreach my $i ( 0 .. $#queries ) {
      my $query     = $queries[$i];
      my $before    = $i ? $queries[ $i - 1 ]->{status} : $sql_status_0;
      my $after     = $query->{status};

      # Accumulate some globals
      $qcost_total += $after->{Last_query_cost};
      $qtime_total += $query->{end} - $query->{start};
      $which_query = $i + 1;
      $query_time  = $query->{end} - $query->{start};
      $ch          = get_changes( $before, $after, 1 );

      # Accumulate query cache invalidations
      $qcache_inval
         = ($ch->{Qcache_inserts} > 0 && $ch->{Qcache_queries_in_cache} == 0)
            || $ch->{Qcache_queries_in_cache} < 0
         ? -$ch->{Qcache_queries_in_cache} - $ch->{Qcache_lowmem_prunes}
         : 0;
      $qcache_inval_total += $qcache_inval;
      $bytes_in_total     += $ch->{Bytes_received};
      $bytes_out_total    += $ch->{Bytes_sent};

      # Print separate stats
      if ( $opts{s} && @queries > 1
         && (!$opts{n} || $opts{n}->{ $i + 1 } ))
      {
         $qcost        = $after->{Last_query_cost};
         ( $query_text = $query->{text} ) =~ s/\s+/ /g;
         $FORMAT_NAME  = $opts{e} ? 'SUMMARY'  : 'QUERY';
         $hdr_type     = $opts{e} ? 'EXTERNAL' : 'QUERY';
         write;
         foreach my $format_name ( @{$formats_for->{$opts{v}}}) {
            $FORMAT_NAME = $format_name;
            write;
         }
      }
   }

   # Print summary stats
   $ch           = get_changes( $sql_status_0, $queries[-1]->{status}, scalar(@queries) );
   $qcache_inval = $qcache_inval_total;
   $qcost        = $qcost_total;
   $FORMAT_NAME  = "SUMMARY";
   write;
   foreach my $format_name ( @{$formats_for->{$opts{v}}}) {
      $FORMAT_NAME = $format_name;
      write;
   }
   if ( !$have_session ) {
      if ( $queries[-1]->{status}->{Questions} - $sql_status_0->{Questions}
         > (@queries * 2) + 1 )
      {
         print STDERR "WARNING: Something else accessed the database at "
            . "the same time you were trying to profile this batch!  These "
            . "numbers are not correct!\n";
      }
      else {
         print STDERR "WARNING: These statistics could be wrong if "
            . "anything else was accessing the database at the same time.\n";
      }
   }
}

$dbh->disconnect;

# ############################################################################
# Subroutines
# ############################################################################

sub flush_tables {
   my ($have_flushed) = @_;
   return if !$opts{f}
      || ( $opts{f} == 1 && $have_flushed );
   eval { $dbh->do("FLUSH TABLES") };
   if ( $EVAL_ERROR ) {
      print STDERR "Warning: can't FLUSH TABLES because $EVAL_ERROR\n";
   }
}

sub get_changes {
   my ( $before, $after, $num_base ) = @_;
   $num_base ||= 1;
   return { map {
      $after->{$_}  ||= 0;
      $before->{$_} ||= 0;
      my $val = $after->{$_} - $before->{$_} - ( $num_base * $base->{$_} );
      if ( $val < 0 && !defined($non_monotonic_vars{$_}) ) {
         # Handle when a ulong wraps over the 32-bit boundary
         $val += MAX_ULONG; # TODO: this isn't right on 64-bit servers.
      }
      $_ => $val;
   } @important_vars };
}

sub get_status_info {
   my $dbh = shift;
   my $res = $dbh->selectall_arrayref(
      $have_session
         ? ($opts{e} ? 'SHOW GLOBAL STATUS' : 'SHOW SESSION STATUS')
         : 'SHOW STATUS' );
   my %result = map { @{$_} } @$res;
   return { map { $_ => $result{$_} || 0 } @important_vars };
}

sub get_variables {
   my $dbh = shift;
   my $res = $dbh->selectall_arrayref('SHOW VARIABLES');
   return { map { @{$_} } @$res };
}

# Compares versions like 5.0.27 and 4.1.15-standard-log
sub version_ge {
   my ( $dbh, $target ) = @_;
   my $version = sprintf('%03d%03d%03d', $dbh->{mysql_serverinfo} =~ m/(\d+)/g);
   return $version ge sprintf('%03d%03d%03d', $target =~ m/(\d+)/g);
}

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

# ############################################################################
# Formats
# ############################################################################

format SUMMARY =

+----------------------------------------------------------+
| @||||||||||||||||||||||||||||||||||||||||||||||||||||||| |
sprintf("$hdr_type %d (%.4f sec)", $which_query, $query_time)
+----------------------------------------------------------+

__ Overall stats _______________________ Value _____________
   Total elapsed time              @##########.###
$qtime_total
   Questions                       @##########
$ch->{Questions}
     COMMIT                        @##########
$ch->{Com_commit}
     DELETE                        @##########
$ch->{Com_delete}
     DELETE MULTI                  @##########
$ch->{Com_delete_multi}
     INSERT                        @##########
$ch->{Com_insert}
     INSERT SELECT                 @##########
$ch->{Com_insert_select}
     REPLACE                       @##########
$ch->{Com_replace}
     REPLACE SELECT                @##########
$ch->{Com_replace_select}
     SELECT                        @##########
$ch->{Com_select}
     UPDATE                        @##########
$ch->{Com_update}
     UPDATE MULTI                  @##########
$ch->{Com_update_multi}
   Data into server                @##########
$bytes_in_total
   Data out of server              @##########
$bytes_out_total
.

format TBL_IDX =

__ Table and index accesses ____________ Value _____________
   Table locks acquired            @##########
$ch->{Table_locks_immediate}
   Table scans                     @##########
$ch->{Select_scan} + $ch->{Select_full_join}
     Join                          @##########
$ch->{Select_full_join}
   Index range scans               @##########
{
   $ch->{Select_range} + $ch->{Select_full_range_join}
   + $ch->{Select_range_check}
}
     Join without check            @##########
$ch->{Select_full_range_join}
     Join with check               @##########
$ch->{Select_range_check}
   Rows sorted                     @##########
$ch->{Sort_rows}
     Range sorts                   @##########
$ch->{Sort_range}
     Merge passes                  @##########
$ch->{Sort_merge_passes}
     Table scans                   @##########
$ch->{Sort_scan}
     Potential filesorts           @##########
min($ch->{Sort_scan}, $ch->{Created_tmp_tables})
.

format QCACHE =
   Query cache
     Hits                          @##########
$ch->{Qcache_hits}
     Inserts                       @##########
$ch->{Qcache_inserts}
     Invalidations                 @##########
$qcache_inval
.

format ROW_OPS_INNODB =

__ Row operations ____________________ Handler ______ InnoDB
   Reads                           @##########   @##########
{
   $ch->{Handler_read_rnd}
   + $ch->{Handler_read_rnd_next}
   + $ch->{Handler_read_key}
   + $ch->{Handler_read_first}
   + $ch->{Handler_read_next}
   + $ch->{Handler_read_prev},
   $ch->{Innodb_rows_read} || 0
}
     Fixed pos (might be sort)     @##########
$ch->{Handler_read_rnd}
     Next row (table scan)         @##########
$ch->{Handler_read_rnd_next}
     Bookmark lookup               @##########
$ch->{Handler_read_key}
     First in index (full scan?)   @##########
$ch->{Handler_read_first}
     Next in index                 @##########
$ch->{Handler_read_next}
     Prev in index                 @##########
$ch->{Handler_read_prev}
   Writes
     Delete                        @##########   @##########
$ch->{Handler_delete}, $ch->{Innodb_rows_deleted}
     Update                        @##########   @##########
$ch->{Handler_update}, $ch->{Innodb_rows_updated}
     Insert                        @##########   @##########
$ch->{Handler_write}, $ch->{Innodb_rows_inserted}
     Commit                        @##########
$ch->{Handler_commit}
.

format ROW_OPS =

__ Row operations ____________________ Handler _____________
   Reads                           @##########
{
   $ch->{Handler_read_rnd}
   + $ch->{Handler_read_rnd_next}
   + $ch->{Handler_read_key}
   + $ch->{Handler_read_first}
   + $ch->{Handler_read_next}
   + $ch->{Handler_read_prev}
}
     Fixed pos (might be sort)     @##########
$ch->{Handler_read_rnd}
     Next row (table scan)         @##########
$ch->{Handler_read_rnd_next}
     Bookmark lookup               @##########
$ch->{Handler_read_key}
     First in index (full scan?)   @##########
$ch->{Handler_read_first}
     Next in index                 @##########
$ch->{Handler_read_next}
     Prev in index                 @##########
$ch->{Handler_read_prev}
   Writes
     Delete                        @##########
$ch->{Handler_delete}
     Update                        @##########
$ch->{Handler_update}
     Insert                        @##########
$ch->{Handler_write}
     Commit                        @##########
$ch->{Handler_commit}
.

format ROW_LOCKS =
   InnoDB row locks
     Number of locks waited for                  @##########
$ch->{Innodb_row_lock_waits}
     Total ms spent acquiring locks              @##########
$ch->{Innodb_row_lock_time}
.

format IO_OPS =

__ I/O Operations _____________________ Memory ________ Disk
   Key cache
     Key reads                     @##########    @#########
$ch->{Key_read_requests}, $ch->{Key_reads}
     Key writes                    @##########    @#########
$ch->{Key_write_requests}, $ch->{Key_writes}
   Temp tables                     @##########    @#########
$ch->{Created_tmp_tables}, $ch->{Created_tmp_disk_tables}
   Temp files                                     @#########
$ch->{Created_tmp_files}
.

format IO_INNODB =
   InnoDB buffer pool
     Reads                         @##########    @#########
$ch->{Innodb_buffer_pool_read_requests}, $ch->{Innodb_buffer_pool_reads}
     Random read-aheads            @##########
$ch->{Innodb_buffer_pool_read_ahead_rnd}
     Sequential read-aheads        @##########
$ch->{Innodb_buffer_pool_read_ahead_seq}
     Write requests                @##########    @#########
$ch->{Innodb_buffer_pool_write_requests}, $ch->{Innodb_buffer_pool_pages_flushed}
     Reads/creates blocked by flushes             @#########
$ch->{Innodb_buffer_pool_wait_free}
   InnoDB log operations
     Log writes                    @##########    @#########
$ch->{Innodb_log_write_requests}, $ch->{Innodb_log_writes}
     Log writes blocked by flushes                @#########
$ch->{Innodb_log_waits}
.

format INNODB_DATA_OPS =

__ InnoDB Data Operations ____ Pages _____ Ops _______ Bytes
   Reads                   @######## @########    @#########
$ch->{Innodb_pages_read}, $ch->{Innodb_data_reads}, $ch->{Innodb_data_read}
   Writes                  @######## @########    @#########
$ch->{Innodb_pages_written}, $ch->{Innodb_data_writes}, $ch->{Innodb_data_written}
   Doublewrites            @######## @########
$ch->{Innodb_dblwr_pages_written}, $ch->{Innodb_dblwr_writes}
   Creates                 @########
$ch->{Innodb_pages_created}
   Fsyncs                            @########
$ch->{Innodb_data_fsyncs}
   OS fsyncs                         @########    @#########
$ch->{Innodb_os_log_fsyncs}, $ch->{Innodb_os_log_written}
.

format QUERY =

+----------------------------------------------------------+
| @||||||||||||||||||||||||||||||||||||||||||||||||||||||| |
sprintf("QUERY %d (%.4f sec)", $which_query, $query_time)
+----------------------------------------------------------+
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
$query_text

__ Overall stats _______________________ Value _____________
   Elapsed time                    @##########.###
$query_time
   Data into server                @##########
$ch->{Bytes_received}
   Data out of server              @##########
$ch->{Bytes_sent}
.

format OPT_COST =
   Optimizer cost                  @##########.###
$qcost
.

# ############################################################################
# Documentation
# ############################################################################

=pod

=head1 NAME

mk-query-profiler - Execute SQL statements and print statistics, or measure
activity caused by other processes.

=head1 SYNOPSIS

mk-query-profiler can profile the (semicolon-terminated, blank-line
separated) queries in a file:

   mk-query-profiler queries.sql
   cat queries.sql | mk-query-profiler
   mk-query-profiler -vv queries.sql
   mk-query-profiler -v --separate --only 2,5,6 queries.sql
   mk-query-profiler --tab queries.sql > results.csv

It can also just observe what happens in the server:

   mk-query-profiler --external

Or it can run shell commands from a file and measure the result:

   mk-query-profiler --external commands.txt
   mk-query-profiler --external - < commands.txt

Read L<"HOW TO INTERPRET"> to learn what it all means.

=head1 OPTIONS

Some options can be negated by prefixing --no to the option name.

=over

=item --allowcache

Allows the MySQL query cache to cache the queries executed.  By default this
is disabled.  When enabled, cache profiling information is added to the
printout.  See L<http://dev.mysql.com/doc/en/query-cache.html> for more
information about the query cache.

=item --askpass

Prompt for password for connections.

=item --calibrate

Makes mk-query-profiler measure and compensate for the "cost of
observation" caused by running SHOW STATUS.  Enabled by default.  Only works
reliably on a quiet server; on a busy server, other processes can cause the
calibration to be wrong.

=item --charset

Enables character set settings in Perl and MySQL.  If the value is C<utf8>, sets
Perl's binmode on STDOUT to utf8, passes the C<mysql_enable_utf8> option to
DBD::mysql, and runs C<SET NAMES UTF8> after connecting to MySQL.  Any other
value sets binmode on STDOUT without the utf8 layer, and runs C<SET NAMES> after
connecting to MySQL.

=item --database

Database to use for connection.

=item --defaults-file

Only read default options from the given file.

=item --external

Makes mk-query-profiler measure the cost of observation, then pause,
typically while you run an external program.  When you press [enter]
mk-query-profiler will stop sleeping and take another measurement, then print
statistics as usual.

When there is a filename on the command line, mk-query-profiler executes
each line in the file as a shell command.  If you give - as the filename,
mk-query-profiler reads from STDIN.

Output from shell commands is printed to STDOUT and terminated with __BEGIN__,
after which mk-query-profiler prints its own output.

=item --flush

Calls FLUSH TABLES before profiling.  If you are executing queries from a
batch file, specifying --flush twice will cause mk-query-profiler to call
FLUSH TABLES between every query, not just once at the beginning.  Default is
not to flush at all. See L<http://dev.mysql.com/doc/en/flush.html> for more
information.

=item --help

Displays a help message.

=item --host

Connect to host.

=item --innodb

Shows InnoDB statistics.  Enabled by default.

=item --only

Only shows statistics for the specified queries or commands in a batch file.
Specify as a comma-separated list of numbers beginning at 1.

=item --password

Password to use for connection.

=item --port

Port number to use for connection.

=item --separate

Print statistics for each query or command in a batch file.  The default is to
show only the summary of the entire batch.  See also L<"--verbose">.

=item --session

Enable session-scoped C<SHOW STATUS> and C<SHOW VARIABLES> when profiling.
Enabled by default; disabled if the server version doesn't support it.

=item --setvars

Specify any variables you want to be set immediately after connecting to MySQL.
These will be included in a C<SET> command.

=item --socket

Socket file to use for connection.

=item --tab

Print tab-separated values for easy reading with a spreadsheet, instead of
whitespace-aligned columns for humans to read.

=item --user

User for login if not current user.

=item --verbose

Verbosity; specify multiple times for more detailed output.  When L<"--tab">
is given, prints variables that don't change.  Otherwise increasing the level
of verbosity includes extra sections in the output.

=item --verify

Verify nothing else is accessing the server.  This is a weak verification; it
simply calibrates twice (see L<"--calibrate">) and verifies that the cost of
observation remains constant.

=item --version

Output version information and exit.

=back

=head1 DESCRIPTION

mk-query-profiler reads a file containing one or more SQL
statements or shell commands, executes them, and analyzes the output of SHOW STATUS afterwards.
It then prints statistics about how the batch performed.  For example, it can
show how many table scans the batch caused, how many page reads, how many
temporary tables, and so forth.

All command-line arguments are optional, but you must either specify a file
containing the batch to profile as the last argument, or specify that you're
profiling an external program with the L<"--external"> option, or provide
input to STDIN.

If the file contains multiple statements, they must be separated by blank
lines.  If you don't do that, mk-query-profiler won't be able to split the
file into individual queries, and MySQL will complain about syntax errors.

If the MySQL server version is before 5.0.2, you should make sure the server
is completely unused before trying to profile a batch.  Prior to this version,
SHOW STATUS showed only global status variables, so other queries will
interfere and produce false results.  mk-query-profiler will try to detect
if anything did interfere, but there can be no guarantees.

Prior to MySQL 5.0.2, InnoDB status variables are not available, and prior to
version 5.0.3, InnoDB row lock status variables are not available.
mk-query-profiler will omit any output related to these variables if they're not
available.

For more information about SHOW STATUS, read the relevant section of the MySQL
manual at
L<http://dev.mysql.com/doc/en/server-status-variables.html>

=head1 HOW TO INTERPRET

=head2 TAB-SEPARATED OUTPUT

If you specify L<"--tab">, you will get the raw output of SHOW STATUS in
tab-separated format, convenient for opening with a spreadsheet.  This is not
the default output, but it's so much easier to describe that I'll cover it
first.

=over

=item *

Most of the command-line options for controlling verbosity and such are
ignored in --tab mode.

=item *

The variable names you see in MySQL, such as 'Com_select', are kept --
there are no euphimisms, so you have to know your MySQL variables.

=item *

The columns are Variable_name, Before, After1...AfterN, Calibration.
The Variable_name column is just what it sounds like.  Before is the result
from the first run of SHOW STATUS.  After1, After2, etc are the results of
running SHOW STATUS after each query in the batch.  Finally, the last column
is the result of running SHOW STATUS just after the last AfterN column, so you
can see how much work SHOW STATUS itself causes.

=item *

If you specify L<"--verbose">, output includes every variable
mk-query-profiler measures.  If not (default) it only includes variables where
there was some difference from one column to the next.

=back

=head2 NORMAL OUTPUT

If you don't specify --tab, you'll get a report formatted for human
readability.  This is the default output format.

mk-query-profiler can output a lot of information, as you've seen if you
ran the examples in the L<"SYNOPSIS">.  What does it all mean?

First, there are two basic groups of information you might see: per-query and
summary.  If your batch contains only one query, these will be the same and
you'll only see the summary.  You can recognize the difference by looking for
centered, all-caps, boxed-in section headers.  Externally profiled commands will
have EXTERNAL, individually profiled queries will have QUERY, and summary will
say SUMMARY.

Next, the information in each section is grouped into subsections, headed by
an underlined title.  Each of these sections has varying information in it.
Which sections you see depends on command-line arguments and your MySQL
version.  I'll explain each section briefly.  If you really want to know where
the numbers come from, read
L<http://dev.mysql.com/doc/en/server-status-variables.html>.

You need to understand which numbers are insulated from other queries and
which are not.  This depends on your MySQL version.  Version 5.0.2 introduced
the concept of session status variables, so you can see information about only
your own connection.  However, many variables aren't session-ized, so when you
have MySQL 5.0.2 or greater, you will actually see a mix of session and global
variables.  That means other queries happening at the same time will pollute
some of your results.  If you have MySQL versions older than 5.0.2, you won't
have ANY connection-specific stats, so your results will be polluted by other
queries no matter what.  Because of the mixture of session and global
variables, by far the best way to profile is on a completely quiet server
where nothing else is interfering with your results.

While explaining the results in the sections that follow, I'll refer to a
value as "protected" if it comes from a session-specific variable and can be
relied upon to be accurate even on a busy server.  Just keep in mind, if
you're not using MySQL 5.0.2 or newer, your results will be inaccurate unless
you're running against a totally quiet server, even if I label it as
"protected."

=head2 Overall stats

This section shows the overall elapsed time for the query, as measured by
Perl, and the optimizer cost as reported by MySQL.

If you're viewing separate query statistics, this is all you'll see.  If
you're looking at a summary, you'll also see a breakdown of the questions the
queries asked the server.

The execution time is not totally reliable, as it includes network round-trip
time, Perl's own execution time, and so on.  However, on a low-latency
network, this should be fairly negligible, giving you a reasonable measure of
the query's time, especially for queries longer than a few tenths of a second.

The optimizer cost comes from the Last_query_cost variable, and is protected
from other connections in MySQL 5.0.7 and greater.  It is not available before
5.0.1.

The total number of questions is not protected, but the breakdown of
individual question types is, because it comes from the Com_ status variables.

=head2 Table and index accesses

This section shows you information about the batch's table and index-level
operations (as opposed to row-level operations, which will be in the next
section).  The "Table locks acquired" and "Temp files" values are unprotected,
but everything else in this section is protected.

The "Potential filesorts" value is calculated as the number of times a query had
both a scan sort (Sort_scan) and created a temporary table (Created_tmp_tables).
There is no Sort_filesort or similar status value, so it's a best guess at
whether a query did a filesort.  It should be fairly accurate.

If you specified L<"--allowcache">, you'll see statistics on the query cache.
These are unprotected.

=head2 Row operations

These values are all about the row-level operations your batch caused.  For
example, how many rows were inserted, updated, or deleted.  You'll also see
row-level index access statistics, such as how many times the query sought and
read the next entry in an index.

Depending on your MySQL version, you'll either see one or two columns of
information in this section.  The one headed "Handler" is all from the
Handler_ variables, and those statistics are protected.  If your MySQL version
supports it, you'll also see a column headed "InnoDB," which is unprotected.

=head2 I/O Operations

This section gives information on I/O operations your batch caused, both in
memory and on disk.  Unless you have MySQL 5.0.2 or greater, you'll only see
information on the key cache.  Otherwise, you'll see a lot of information on
InnoDB's I/O operations as well, such as how many times the query was able to
satisfy a read from the buffer pool and how many times it had to go to the
disk.

None of the information in this section is protected.

=head2 InnoDB Data Operations

This section only appears when you're querying MySQL 5.0.2 or newer.  None of
the information is protected.  You'll see statistics about how many pages were
affected, how many operations took place, and how many bytes were affected.

=head1 ENVIRONMENT

The environment variable C<MKDEBUG> enables verbose debugging output in all of
the Maatkit tools:

   MKDEBUG=1 mk-....

=head1 BUGS

Please use the Sourceforge bug tracker, forums, and mailing lists to request
support or report bugs: L<http://sourceforge.net/projects/maatkit/>.

=head1 SYSTEM REQUIREMENTS

You need Perl, DBI, DBD::mysql, and some core modules.

=head1 SEE ALSO

See also L<mk-profile-compact>.

=head1 LICENSE

This program is copyright (c) 2007 Baron Schwartz.
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.

=head1 AUTHOR

Baron Schwartz.

=head1 ACKNOWLEDGEMENTS

I was inspired by the wonderful mysqlreport utility available at
L<http://www.hackmysql.com/>.

Other contributors: Bart van Bragt.

Thanks to all who have helped.

=head1 VERSION

This manual page documents Ver 1.1.9 Distrib 1877 $Revision: 1871 $.

=cut