#!/usr/bin/perl

# This is mk-visual-explain, a program to transform MySQL's EXPLAIN output
# into a query execution plan formatted as a tree.
#
# 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.0.7';
our $DISTRIB = '1877';
our $SVN_REV = sprintf("%d", map { $_ || 0 } q$Revision: 1871 $ =~ m/(\d+)/g);

# ###########################################################################
# This is a combination of modules and programs in one -- a runnable module.
# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
# ###########################################################################

# ###########################################################################
# Converts text (e.g. saved output) to a "recordset" -- an array of hashrefs
# -- just like EXPLAIN does for selectall_arrayref({}).
# ###########################################################################
package ExplainParser;

sub new {
   bless {}, shift;
}

sub parse_tabular {
   my ( $text, @cols ) = @_;
   my %row;
   my @vals = $text =~ m/\| +([^\|]*?)(?= +\|)/msg;
   return (undef, \@vals) unless @cols;
   @row{@cols} = @vals;
   return (\%row, undef);
}

sub parse_tab_sep {
   my ( $text, @cols ) = @_;
   my %row;
   my @vals = split(/\t/, $text);
   return (undef, \@vals) unless @cols;
   @row{@cols} = @vals;
   return (\%row, undef);
}

sub parse_vertical {
   my ( $text, @cols ) = @_;
   my %row = $text =~ m/^ *(\w+): ([^\n]*) *$/msg;
   return (\%row, undef);
}

sub parse {
   my ($self, $text) = @_;
   my $started = 0;
   my $lines   = 0;
   my @cols    = ();
   my @result  = ();

   # Detect which kind of input it is
   my ( $line_re, $vals_sub );
   if ( $text =~ m/^\+---/m ) { # standard "tabular" output
      $line_re  = qr/^(\| .*)[\r\n]+/m;
      $vals_sub = \&parse_tabular;
   }
   elsif ( $text =~ m/^id\tselect_type\t/m ) { # tab-separated
      $line_re  = qr/^(.*?\t.*)[\r\n]+/m;
      $vals_sub = \&parse_tab_sep;
   }
   elsif ( $text =~ m/\*\*\* 1. row/ ) { # "vertical" output
      $line_re  = qr/^( *.*?^ *Extra:[^\n]*$)/ms;
      $vals_sub = \&parse_vertical;
   }

   if ( $line_re ) {
      # Pull it apart into lines and parse them.
      LINE:
      foreach my $line ( $text =~ m/$line_re/g ) {
         my ($row, $cols) = $vals_sub->($line, @cols);
         if ( $row ) {
            foreach my $key ( keys %$row ) {
               if ( !$row->{$key} || $row->{$key} eq 'NULL' ) {
                  $row->{$key} = undef;
               }
            }
            push @result, $row;
         }
         else {
            @cols = @$cols;
         }
      }
   }

   return \@result;
}

# ###########################################################################
# Converts output of EXPLAIN into a human-readable tree.
# ###########################################################################
package ExplainTree;

use List::Util qw(max);
use Data::Dumper;

sub new {
   my ( $class, $options ) = @_;
   my $self = bless {}, $class;
   $self->load_options($options);
   return $self;
}

sub load_options {
   my ( $self, $options ) = @_;
   if ( $options && ref $options eq 'HASH' ) {
      @{$self}{keys %$options} = values %$options;
   }
   else {
      delete @{$self}{keys %$self};
   }
}

sub parse {
   my ( $self, $text, $options ) = @_;
   return $self->process(ExplainParser->new->parse($text), $options);
}

# The main method that turns a result set into a tree.  Accepts an arrayref of
# hashrefs which correspond to the rows in EXPLAIN.  See the ALGORITHM in the
# documentation for a small novel about this process.
sub process {
   my ( $self, $rows, $options ) = @_;
   $self->load_options($options);
   return unless ref $rows eq 'ARRAY' && @$rows;

   # Pre-process and sanity check the rows.
   my @rows = @$rows;
   foreach my $i ( 0 .. $#rows ) {
      my $row = $rows[$i];
      $row->{rowid} = $i;
      $row->{Extra} ||= '';

      # The source code says if there are too many tables unioned together, the
      # table column will get truncated, like "<union1,2,3,4...>".  If this
      # happens, I've got to bail out.  I'm not going to check all the source
      # code for all versions, but in 5.0 it looks like I can get this to happen
      # around table 20.
      die "UNION has too many tables: $row->{table}"
         if $row->{table} && $row->{table} =~ m/\./;

      if ( !defined $row->{id} ) {
         if ( $row->{table} && (my ($id) = $row->{table} =~ m/^<union(\d+)/) ) {
            $row->{id} = $id;
         }
         else {
            die "Unexpected NULL in id column, please report as a bug";
         }
      }
   }

   # Re-order the rows so all references are forward.
   my %union_for
      = map  { $_->{id} => $_ }
        grep { $_->{select_type} eq 'UNION RESULT' }
        @rows;

   my $last_id = 0;
   my @reordered;
   foreach my $row ( grep { $_->{select_type} ne 'UNION RESULT' } @rows ) {
      if ( $last_id != $row->{id} && $union_for{$row->{id}} ) {
         push @reordered, $union_for{$row->{id}};
      }
      push @reordered, $row;
      $last_id = $row->{id};
   }

   # Process the rows recursively.
   my $tree = $self->build_query_plan(@reordered);

   return $tree;
}

sub build_query_plan {
   my ( $self, @rows ) = @_;

   if ( !@rows ) {
      die "I got no rows";
   }

   # Is it a UNION RESULT?  Split it up into sub-scopes and recurse.
   if ( $rows[0]->{select_type} eq 'UNION RESULT' ) {
      my $row = shift @rows;
      my @kids;
      my @ids   = $row->{table} =~ m/(\d+)/g;
      my $enclosing_scope;
      if ( $rows[0]->{select_type} =~ m/SUBQUERY/ ) {
         $enclosing_scope = $rows[0];
      }
      foreach my $i ( 0 .. $#ids ) {
         my $start = $self->index_of($ids[$i], @rows);
         my $end   = $i < $#ids ? $self->index_of($ids[$i + 1], @rows) : @rows;
         push @kids, $self->build_query_plan(splice(@rows, $start, $end - $start));
      }
      $row->{children} = [ @kids ];
      $row->{table}    = "union("
         . join(',', map { $self->recursive_table_name($_) || '<none>' } @kids)
         . ")";
      my $tree = $self->transform($row);
      if ( $enclosing_scope ) {
         my $node = $self->transform($enclosing_scope);
         $node->{children} = [ $tree ];
         $tree = $node;
      }
      return $tree;
   }

   # Are there DERIVED tables?  If so, find its children and pull them out of the
   # list under it.
   while ( my ($der) = grep { $_->{table} && $_->{table} =~ m/^<derived\d+>$/ } @rows ) {

      # Figure out the start and end of the derived scope.
      my ($der_id) = $der->{table} =~ m/^<derived(\d+)>$/;
      my $start    = $self->index_of($der_id, @rows);
      my $end      = $start;
      while ( $end < @rows && $rows[$end]->{id} >= $der_id ) {
         $end++;
      }

      # Get the rows that belong to this scope and recurse.
      my @enclosed_scope = splice(@rows, $start, $end - $start);
      my $kids           = $self->build_query_plan(@enclosed_scope);
      $der->{children}   = [$kids];
      $der->{table}      = "derived(" . ($self->recursive_table_name($kids) || '<none>') . ")";
   }

   # Handle the "normal case."  For each node, if the id is the same as the last
   # one, JOIN and continue.  If the id is greater, it's a subquery, so should
   # be recursed.

   # But, filesort/temporary have to be handled specially, because they appear
   # in the first row, even if they are done later.  Here are the cases,
   # according to http://s.petrunia.net/blog/?p=24:

   # ... MySQL has three ways to run a join and produce ordered output:
   # Method                               EXPLAIN output
   # ##################################   ####################################
   # Use index-based access method that   no mention of filesort
   # produces ordered output
   # ----------------------------------   ------------------------------------
   # Use filesort() on 1st non-constant   "Using filesort" in the first row
   # table
   # ----------------------------------   ------------------------------------
   # Put join result into a temporary     "Using temporary; Using filesort" in
   # table and use filesort() on it       the first row
   # ----------------------------------   ------------------------------------

   my $first = shift(@rows);

   # This is "case three" above.
   my $is_temp_filesort;
   if ( $first->{Extra} =~ m/Using temporary; Using filesort/ ) {
      # The entire join is being placed into a temporary table and filesorted,
      # so I'll make a note of that and apply it afterwards.  In the meantime I
      # must remove mention of it from the node so the node doesn't get extra
      # transformations in transform().
      $is_temp_filesort = 1;
      $first->{Extra} =~ s/Using temporary; Using filesort(?:; )?//;
   }

   # This is "case two" above.  Must find first non-constant table and move
   # the filesort() there.
   elsif ( $first->{Extra} =~ m/Using filesort/ && $first->{type} =~ m/^(?:system|const)$/ ) {
      my ( $first_non_const ) = grep { $_->{type} !~ m/^(?:system|const)$/ } @rows;
      if ( $first_non_const ) {
         $first->{Extra} =~ s/Using filesort(?:; )?//;
         $first_non_const->{Extra} .= '; Using filesort';
      }
   }

   my $scope = $first->{id};
   my $tree  = $self->transform($first);
   my $i     = 0;
   while ( $i < @rows ) {
      my $row = $rows[$i];
      if ( $row->{id} == $scope ) {
         $tree = {
            type     => 'JOIN',
            children => [ $tree, $self->transform($row) ],
         };
         $i++;
      }
      else {
         # It's another kind of "join".  Find the enclosing scope boundaries and
         # recurse.  The scope starts at $i.
         my $end = $i;
         while ( $end < @rows && $rows[$end]->{id} >= $row->{id} ) {
            $end++;
         }
         my @enclosed_scope = splice(@rows, $i, $end - $i);
         $tree = {
            type     => $row->{select_type},
            children => [ $tree, $self->build_query_plan(@enclosed_scope) ],
         };
         # Don't increment the pointer because I just removed rows from @rows.
         # $i++
      }
   }

   if ( $is_temp_filesort ) {
      $tree = $self->filesort(
         $self->temporary($tree, $self->recursive_table_name($tree)));
   }

   return $tree;
}

# TODO: "Using index condition" see http://bugs.mysql.com/bug.php?id=30659
sub transform {
   my ( $self, $row ) = @_;

   my $sub = $row->{type};

   # ##################################################################
   # Dispatch to a class method to generate the tree.
   # ##################################################################
   my $no_matching_row = join('|',
      "Impossible (?:WHERE|HAVING)(?: noticed after reading const tables)?",
      'No matching.*row',
      '(?:unique|const) row not found',
   );
   my $node
      = $sub
         ? $self->$sub($row)
      : $row->{Extra} =~ m/No tables/
         ? { type => ( $row->{select_type} !~ m/^(?:PRIMARY|SIMPLE)$/
                     ? $row->{select_type}
                     : 'DUAL') }
      : $row->{Extra} =~ m/(?:$no_matching_row)/i
         ? { type => 'IMPOSSIBLE' }
      : $row->{Extra} =~ m/optimized away/
         ? { type => 'CONSTANT' }
      : die "Can't handle " . Dumper($row);

   my ($warn) = $row->{Extra} =~ m/($no_matching_row)/;
   if ( $warn ) {
      $node->{warning} = $warn;
   }

   # ##################################################################
   # Apply other tree transformations.
   # ##################################################################
   if ( $row->{Extra} =~ m/Using where/ ) {
      $node = {
         type     => 'Filter with WHERE',
         children => [$node],
      };
   }

   if ( $row->{Extra} =~ m/Using join buffer/ ) {
      $node = {
         type     => 'Join buffer',
         children => [$node],
      };
   }

   if ( $row->{Extra} =~ m/Distinct|Not exists/ ) {
      $node = {
         type     => 'Distinct/Not-Exists',
         children => [$node],
      };
   }

   if ( $row->{Extra} =~ m/Range checked for each record \(\w+ map: ([^\)]+)\)/ ) {
      # (index map: N) is a bitmap of which indexes are used.  For example:
      #  0x5  base 16 (or base 10)
      # 0101  base 2
      # 4321  position of bits
      #  3 1  indexes used
      my $bitmap = eval "int($1)";                    # Hex to decimal if it begins with '0x'
      $bitmap    = unpack("B32", pack("N", $bitmap)); # Convert into binary string of 1/0
      $bitmap    =~ s/^0+//;                          # Remove leading zeros
      $bitmap    = reverse $bitmap;                   # Iterate from left-to-right
      my $possible_keys = join(',',
         grep { substr($bitmap, $_ - 1, 1) }
        ( 1 .. length($bitmap) ));
      $node = {
         type          => 'Re-evaluate indexes each row',
         possible_keys => $possible_keys,
         children      => [$node],
      };
   }

   if ( $row->{Extra} =~ m/Using filesort/ ) {
      $node = $self->filesort($node);
   }

   if ( $row->{Extra} =~ m/Using temporary/ ) {
      $node = $self->temporary($node, $row->{table}, 1);
   }

   # Add some data that will help me keep track of nodes as I manipulate
   # them later
   $node->{id}    = $row->{id};
   $node->{rowid} = $row->{rowid};

   return $node;
}

sub index_of {
   my ( $self, $id, @rows ) = @_;
   my $i = 0;
   foreach my $row ( @rows ) {
      if ( $row->{id} && $row->{id} == $id ) {
         return $i;
      }
      $i++;
   }
   die "Can't find row $id in "
      . join(',', map { $_->{id} || '' } @rows);
}

sub pretty_print {
   my ( $self, $node, $prefix ) = @_;
   $prefix ||= '';
   my $branch = $prefix ? substr($prefix, 0, length($prefix) -3) . '+- ' : '';
   my $output = $branch . $node->{type} . "\n";

   my @kids;
   if ( $node->{children} ) {
      @kids   = reverse @{$node->{children}};
   }
   my $suffix = (@kids > 1) ? '|  ' : '   ';

   foreach my $thing ( qw(table key partitions possible_keys method key_len ref rows warning) ) {
      if ( defined $node->{$thing} ) {
         $output .= $prefix . sprintf('%-14s %s', $thing, $node->{$thing}) . "\n";
      }
   }

   my $last_child = pop @kids;
   foreach my $child ( @kids ) {
      $output .= $self->pretty_print($child, $prefix . $suffix);
   }
   if ( $last_child ) {
      $output .= $self->pretty_print($last_child, $prefix . '   ');
   }
   return $output;
}

#############################################################################
# Each method in this section corresponds to a value you will find in the 'type'
# column in EXPLAIN.
#############################################################################

sub ALL {
   my ( $self, $row ) = @_;
   return {
      type     => 'Table scan',
      rows     => $row->{rows},
      children => [$self->table($row)],
   };
}

sub fulltext {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Fulltext scan');
}

sub range {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Index range scan');
}

sub index {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Index scan');
}

sub eq_ref {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Unique index lookup');
}

sub ref {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Index lookup');
}

sub ref_or_null {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Index lookup with extra null lookup');
}

sub const {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Constant index lookup');
}

sub system {
   my ( $self, $row ) = @_;
   return {
      type => 'Constant table access',
      rows     => $row->{rows},
      children => [$self->table($row)],
   };
}

sub unique_subquery {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Unique subquery');
}

sub index_subquery {
   my ( $self, $row ) = @_;
   return $self->index_access($row, 'Index subquery');
}

# From the manual: "The Index Merge method is used to retrieve rows with
# several range scans and to merge their results into one."  Therefore each
# index access should be shown as an index range scan.  The unions and
# intersections can be recursive, as in
# union(intersect(key1,key2),intersect(key3,key4))
sub index_merge {
   my ( $self, $row ) = @_;
   my ( $merge_spec )
      = $row->{Extra} =~ m/Using ((?:intersect|union|sort_union)\(.*?\))(?=;|$)/;
   my ($merge, $num) = $self->recurse_index_merge($row, $merge_spec, 0);

   # index_merge_bookmark_lookup note:
   # From the manual, "If the used indexes don't cover all columns used in the
   # query, full rows are retrieved only when the range conditions for all
   # used keys are satisfied."  So a bookmark lookup shouldn't be shown for
   # all indexes; it should be shown from the merge results.
   return $self->bookmark_lookup($merge, $row);
}

# ###########################################################################
# Helper subroutines.
# ###########################################################################

sub recursive_table_name {
   my ( $self, $node ) = @_;
   if ( $node->{table} ) {
      return $node->{table};
   }
   if ( $node->{key} ) {
      my ( $table ) = $node->{key} =~ m/(.*?)->/;
      return $table;
   }
   if ( $node->{type} eq 'Bookmark lookup' ) {
      return $node->{children}->[1]->{table};
   }
   if ( $node->{type} eq 'IMPOSSIBLE' ) {
      return '<none>';
   }
   if ( $node->{children} ) {
      return join(',',
         grep { $_ }
         map  { $self->recursive_table_name($_) }
              @{$node->{children}});
   }
}

# $num is the number of nodes to the left of this node in a depth-first
# traversal.  It lets me figure out which value goes in key_len.
sub recurse_index_merge {
   my ( $self, $row, $spec, $num ) = @_;
   my ($type, $args) = $spec =~ m/(intersect|union|sort_union)\((.*)\)$/;

   my @children;

   # See 'man perlre' and search for 'matches a parenthesized group'.
   my $bal;
   $bal = qr/
      \(
      (?:
         (?> [^()]+ )    # Non-parens without backtracking
         |
         (??{ $bal })     # Group with matching parens
      )*
      \)
   /x;

   # Extract a thing, followed by balanced parentheses.
   foreach my $child ( $args =~ m/(\w+$bal)/g ) {
      my ( $subtree, $num ) = $self->recurse_index_merge($row, $child, $num);
      push @children, $subtree;
   }

   if ( !@children ) { # Recursion base case; $args is an index list
      foreach my $idx ( split(/,/, $args) ) {
         my $index_scan = $self->index_access($row, 'Index range scan', $idx);
         $index_scan->{key_len} = ($row->{key_len} =~ m/(\d+)/g)[$num++];
         push @children, $index_scan;
      }
   }

   return (
      {
         type     => 'Index merge',
         method   => $type,
         rows     => $row->{rows},
         children => \@children,
      },
      $num
   );

}

sub table {
   my ( $self, $row ) = @_;
   my $node = {
      type          => ($row->{table} && $row->{table} =~ m/^(derived|union)\(/)
                       ? uc $1
                       : 'Table',
      table         => $row->{table},
      possible_keys => $row->{possible_keys},
      partitions    => $row->{partitions},
   };
   if ( $row->{children} ) {
      $node->{children} = $row->{children};
   }
   return $node;
}

sub bookmark_lookup {
   my ( $self, $node, $row ) = @_;
   if ( $row->{Extra} =~ m/Using index/
         || ( $self->{clustered} && $row->{key} && $row->{key} eq 'PRIMARY' ))
   {
      return $node;
   }
   return {
      type     => 'Bookmark lookup',
      children => [ $node, $self->table($row) ],
   };
}

sub filesort {
   my ( $self, $node ) = @_;
   return {
      type     => 'Filesort',
      children => [$node],
   };
}

sub temporary {
   my ( $self, $node, $table_name, $is_scan ) = @_;
   $node = {
      type          => 'TEMPORARY',
      table         => "temporary($table_name)",
      possible_keys => undef,
      partitions    => undef,
      children      => [$node],
   };
   if ( $is_scan ) {
      $node = {
         type     => 'Table scan',
         rows     => undef,
         children => [ $node ],
      };
   }
   return $node;
}

sub index_access {
   my ( $self, $row, $type, $key ) = @_;
   my $node = {
      type          => $type,
      key           => $row->{table} . '->' . ( $key || $row->{key} ),
      possible_keys => $row->{possible_keys},
      partitions    => $row->{partitions},
      key_len       => $row->{key_len},
      'ref'         => $row->{ref},
      rows          => $row->{rows},
   };
   if ( $row->{Extra} =~ m/Full scan on NULL key/ ) {
      $node->{warning} = 'Full scan on NULL key';
   }
   if ( $row->{Extra} =~ m/Using index for group-by/ ) {
      $node->{type} = 'Loose index scan';
   }
   # See index_merge_bookmark_lookup note above.
   if ( $row->{type} ne 'index_merge' ) {
      $node = $self->bookmark_lookup($node, $row);
   }
   return $node;
}

# ###########################################################################
# 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
# ###########################################################################

# ###########################################################################
# And now for the "program".
# ###########################################################################
package main;

use English qw(-no_match_vars);
use Data::Dumper;

$Data::Dumper::Indent    = 1;
$Data::Dumper::Quotekeys = 0;

if ( !caller ) {

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

   my @opt_spec = (
      { s => 'askpass',           d => 'Prompt for password for connections' },
      { s => 'charset|A=s',       d => 'Default character set' },
      { s => 'clusterpk|C',       d => 'Assume clustered PK, as for InnoDB' },
      { s => 'connect|c',         d => 'Connect and EXPLAIN the input, then transform' },
      { s => 'database|D=s',      d => 'Database to use' },
      { s => 'defaults-file|F=s', d => 'Only read mysql options from the given file' },
      { s => 'format|f=s',        d => 'Output formatting; default tree' },
      { s => 'host|h=s',          d => 'Connect to host' },
      { s => 'password|p=s',      d => 'Password to use when connecting' },
      { s => 'port|P=i',          d => 'Port number to use for connection' },
      { s => 'setvars=s',         d => 'Set these MySQL variables (default wait_timeout=10000)' },
      { s => 'socket|S=s',        d => 'Socket file to use for connection' },
      { s => 'user|u=s',          d => 'User for login if not current user' },
   );

   my $opt_parser = new OptionParser(@opt_spec);
   $opt_parser->{strict} = 0;
   $opt_parser->{prompt} = '<options> [FILE]...';
   $opt_parser->{descr} = q{transforms EXPLAIN output into a tree }
                        . q{representation of the query plan.  If FILE is }
                        . q{given, input is read from the file(s).  With no }
                        . q{FILE, or when FILE is -, read standard input.};
   my %opts = $opt_parser->parse();
   $opt_parser->usage_or_errors(%opts);
   my $dp = new DSNParser();
   $dp->prop('setvars', $opts{setvars});

   # ############################################################################
   # Do the main work.
   # ############################################################################
   # Magically read STDIN or files in @ARGV
   my $text = do { local $INPUT_RECORD_SEPARATOR = undef; <>; };
   my $rows;

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

      my $dbh = $dp->get_dbh(
         $dp->get_cxn_params(\%opts), { AutoCommit => 1 } );
      $text =~ s{^.*?select}{EXPLAIN /*!50115 PARTITIONS*/ SELECT}is;
      $rows = $dbh->selectall_arrayref($text, { Slice => {} } );
      $dbh->disconnect;
   }
   else {
      $rows = ExplainParser->new->parse($text);
   }

   my $et   = ExplainTree->new();
   my $tree = $et->process($rows, { clustered => $opts{C} });
   if ( $tree ) {
      print $opts{f} eq 'dump' ? Dumper($tree)
          :                      $et->pretty_print($tree);
   }
}

1; # Because this is a module as well as a script.

# ############################################################################
# Documentation.
# ############################################################################

=pod

=head1 NAME

mk-visual-explain - Format EXPLAIN output as a tree.

=head1 SYNOPSIS

 mk-visual-explain <file_containing_explain_output>
 mk-visual-explain -c <file_containing_query>
 mysql -e "explain select * from mysql.user" | mk-visual-explain

=head1 DESCRIPTION

mk-visual-explain reverse-engineers MySQL's EXPLAIN output into a query
execution plan, which it then formats as a left-deep tree -- the same way the
plan is represented inside MySQL.  It is possible to do this by hand, or to read
EXPLAIN's output directly, but it requires patience and expertise.  Many people
find a tree representation more understandable.

You can pipe input into mk-visual-explain or specify a filename at the
command line, including the magical '-' filename, which will read from standard
input.  It can do two things with the input: parse it for something that looks
like EXPLAIN output, or connect to a MySQL instance and run EXPLAIN on the
input.

When parsing its input, mk-visual-explain understands three formats: tabular
like that shown in the mysql command-line client, vertical like that created by
using the \G line terminator in the mysql command-line client, and tab
separated.  It ignores any lines it doesn't know how to parse.

When executing the input, mk-visual-explain replaces everything in the input
up to the first SELECT keyword with 'EXPLAIN SELECT,' and then executes the
result.  You must specify L<"--connect"> to execute the input as a query.

Either way, it builds a tree from the result set and prints it to standard
output.  For the following query,

 select * from sakila.film_actor join sakila.film using(film_id);

mk-visual-explain generates this query plan:

 JOIN
 +- Bookmark lookup
 |  +- Table
 |  |  table          film_actor
 |  |  possible_keys  idx_fk_film_id
 |  +- Index lookup
 |     key            film_actor->idx_fk_film_id
 |     possible_keys  idx_fk_film_id
 |     key_len        2
 |     ref            sakila.film.film_id
 |     rows           2
 +- Table scan
    rows           952
    +- Table
       table          film
       possible_keys  PRIMARY

The query plan is left-deep, depth-first search, and the tree's root is the
output node -- the last step in the execution plan.  In other words, read it
like this:

=over

=item 1

Table scan the 'film' table, which accesses an estimated 952 rows.

=item 2

For each row, find matching rows by doing an index lookup into the
film_actor->idx_fk_film_id index with the value from sakila.film.film_id, then a
bookmark lookup into the film_actor table.

=back

For more information on how to read EXPLAIN output, please see
L<http://dev.mysql.com/doc/en/explain.html>, and this talk titled "Query
Optimizer Internals and What's New in the MySQL 5.2 Optimizer," from Timour
Katchaounov, one of the MySQL developers:
L<http://conferences.oreillynet.com/presentations/mysql07/katchaounov_timour.pdf>.

=head1 OPTIONS

=over

=item --askpass

Prompt for password for connections.

=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 --clusterpk

Assume that PRIMARY KEY index accesses don't need to do a bookmark lookup to
retrieve rows.  This is the case for InnoDB.

=item --connect

Treat input as a query, and obtain EXPLAIN output by connecting to a MySQL
instance and running EXPLAIN on the query.  When this option is given,
mk-visual-explain uses the other connection-specific options such as L<"--user"> to
connect to the MySQL instance.  If you have a .my.cnf file, it will read it, so
you may not need to specify any connection-specific options.

=item --database

Connect to this database.

=item --defaults-file

If you specify this option, only this file is read for MySQL default options;
otherwise all the default files will be read.

=item --format

Controls the output formatting.  The default is a terse pretty-printed tree.
The valid values are:

 value  meaning
 =====  =======
 tree   Pretty-printed terse tree.
 dump   Data::Dumper output (see L<Data::Dumper> for more).

=item --help

Displays a help message.

=item --host

MySQL host to connect to.

=item --password

The password to use when connecting.

=item --port

The port number to use for the connection.

=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

The socket file to use for the connection.

=item --user

MySQL user account to use for the connection.

=item --version

Output version information and exit.

=back

=head1 MODULES

This program is actually a runnable module, not just an ordinary Perl script.
In fact, there are two modules embedded in it.  This makes unit testing easy,
but it also makes it easy for you to use the parsing and tree-building
functionality if you want.

The ExplainParser package accepts a string and parses whatever it thinks looks
like EXPLAIN output from it.  The synopsis is as follows:

 require "mk-visual-explain";
 my $p    = ExplainParser->new();
 my $rows = $p->parse("some text");
 # $rows is an arrayref of hashrefs.

The ExplainTree package accepts a set of rows and turns it into a tree.  For
convenience, you can also have it delegate to ExplainParser and parse text for
you.  Here's the synopsis:

 require "mk-visual-explain";
 my $e      = ExplainTree->new();
 my $tree   = $e->parse("some text", \%options);
 my $output = $e->pretty_print($tree);
 print $tree;

=head1 ALGORITHM

This section explains the algorithm that converts EXPLAIN into a tree.  You may
be interested in reading this if you want to understand EXPLAIN more fully, or
trying to figure out how this works, but otherwise this section will probably
not make your life richer.

The tree can be built by examining the id, select_type, and table columns of
each row.  Here's what I know about them:

The id column is the sequential number of the select.  This does not indicate
nesting; it just comes from counting SELECT from the left of the SQL statement.
It's like capturing parentheses in a regular expression.  A UNION RESULT row
doesn't have an id, because it isn't a SELECT.  The source code actually refers
to UNIONs as a fake_lex, as I recall.

If two adjacent rows have the same id value, they are joined with the standard
single-sweep multi-join method.

The select_type column tells a) that a new sub-scope has opened b) what kind
of relationship the row has to the previous row c) what kind of operation the
row represents.

=over

=item *

SIMPLE means there are no subqueries or unions in the whole query.

=item *

PRIMARY means there are, but this is the outermost SELECT.

=item  *

[DEPENDENT] UNION means this result is UNIONed with the previous result (not
row; a result might encompass more than one row).

=item *

UNION RESULT terminates a set of UNIONed results.

=item *

[DEPENDENT|UNCACHEABLE] SUBQUERY means a new sub-scope is opening.  This is the
kind of subquery that happens in a WHERE clause, SELECT list or whatnot; it does
not return a so-called "derived table."

=item *

DERIVED is a subquery in the FROM clause.

=back

Tables that are JOINed all have the same select_type.  For example, if you JOIN
three tables inside a dependent subquery, they'll all say the same thing:
DEPENDENT SUBQUERY.

The table column usually specifies the table name or alias, but may also say
<derivedN> or <unionN,N...N>.  If it says <derivedN>, the row represents an
access to the temporary table that holds the result of the subquery whose id is
N.  If it says <unionN,..N> it's the same thing, but it refers to the results it
UNIONs together.

Finally, order matters.  If a row's id is less than the one before it, I think
that means it is dependent on something other than the one before it.  For
example,

 explain select
    (select 1 from sakila.film),
    (select 2 from sakila.film_actor),
    (select 3 from sakila.actor);

 | id | select_type | table      |
 +----+-------------+------------+
 |  1 | PRIMARY     | NULL       |
 |  4 | SUBQUERY    | actor      |
 |  3 | SUBQUERY    | film_actor |
 |  2 | SUBQUERY    | film       |

If the results were in order 2-3-4, I think that would mean 3 is a subquery of
2, 4 is a subquery of 3.  As it is, this means 4 is a subquery of the neares
previous recent row with a smaller id, which is 1.  Likewise for 3 and 2.

This structure is hard to programatically build into a tree for the same reason
it's hard to understand by inspection: there are both forward and backward
references.  <derivedN> is a forward reference to selectN, while <unionM,N> is a
backward reference to selectM and selectN.  That makes recursion and other
tree-building algorithms hard to get right (NOTE: after implementation, I now
see how it would be possible to deal with both forward and backward references,
but I have no motivation to change something that works).  Consider the
following:

 select * from (
    select 1 from sakila.actor as actor_1
    union
    select 1 from sakila.actor as actor_2
 ) as der_1
 union
 select * from (
    select 1 from sakila.actor as actor_3
    union all
    select 1 from sakila.actor as actor_4
 ) as der_2;

 | id   | select_type  | table      |
 +------+--------------+------------+
 |  1   | PRIMARY      | <derived2> |
 |  2   | DERIVED      | actor_1    |
 |  3   | UNION        | actor_2    |
 | NULL | UNION RESULT | <union2,3> |
 |  4   | UNION        | <derived5> |
 |  5   | DERIVED      | actor_3    |
 |  6   | UNION        | actor_4    |
 | NULL | UNION RESULT | <union5,6> |
 | NULL | UNION RESULT | <union1,4> |

This would be a lot easier to work with if it looked like this (I've
bracketed the id on rows I moved):

 | id   | select_type  | table      |
 +------+--------------+------------+
 | [1]  | UNION RESULT | <union1,4> |
 |  1   | PRIMARY      | <derived2> |
 | [2]  | UNION RESULT | <union2,3> |
 |  2   | DERIVED      | actor_1    |
 |  3   | UNION        | actor_2    |
 |  4   | UNION        | <derived5> |
 | [5]  | UNION RESULT | <union5,6> |
 |  5   | DERIVED      | actor_3    |
 |  6   | UNION        | actor_4    |

In fact, why not re-number all the ids, so the PRIMARY row becomes 2, and so on?
That would make it even easier to read.  Unfortunately that would also have the
effect of destroying the meaning of the id column, which I think is important to
preserve in the final tree.  Also, though it makes it easier to read, it doesn't
make it easier to manipulate programmatically; so it's fine to leave them
numbered as they are.

The goal of re-ordering is to make it easier to figure out which rows are
children of which rows in the execution plan.  Given the reordered list and some
row whose table is <union...> or <derived>, it is easy to find the beginning of
the slice of rows that should be child nodes in the tree: you just look for the
first row whose ID is the same as the first number in the table.

The next question is how to find the last row that should be a child node of a
UNION or DERIVED.   I'll start with DERIVED, because the solution makes UNION
easy.

Consider how MySQL numbers the SELECTs sequentially according to their position
in the SQL, left-to-right.  Since a DERIVED table encloses everything within it
in a scope, which becomes a temporary table, there are only two things to think
about: its child subqueries and unions (if any), and its next siblings in the
scope that encloses it.  Its children will all have an id greater than it does,
by definition, so any later rows with a smaller id terminate the scope.

Here's an example.  The middle derived table here has a subquery and a UNION to
make it a little more complex for the example.

 explain select 1
 from (
    select film_id from sakila.film limit 1
 ) as der_1
 join (
    select film_id, actor_id, (select count(*) from sakila.rental) as r
    from sakila.film_actor limit 1
    union all
    select 1, 1, 1 from sakila.film_actor as dummy
 ) as der_2 using (film_id)
 join (
    select actor_id from sakila.actor limit 1
 ) as der_3 using (actor_id);

Here's the output of EXPLAIN:

 | id   | select_type  | table      |
 |  1   | PRIMARY      | <derived2> |
 |  1   | PRIMARY      | <derived6> |
 |  1   | PRIMARY      | <derived3> |
 |  6   | DERIVED      | actor      |
 |  3   | DERIVED      | film_actor |
 |  4   | SUBQUERY     | rental     |
 |  5   | UNION        | dummy      |
 | NULL | UNION RESULT | <union3,5> |
 |  2   | DERIVED      | film       |

The siblings all have id 1, and the middle one I care about is derived3.
(Notice MySQL doesn't execute them in the order I defined them, which is fine).
Now notice that MySQL prints out the rows in the opposite order I defined the
subqueries: 6, 3, 2.  It always seems to do this, and there might be other
methods of finding the scope boundaries including looking for the lower boundary
of the next largest sibling, but this is a good enough heuristic.  I am forced
to rely on it for non-DERIVED subqueries, so I rely on it here too.  Therefore,
I decide that everything greater than or equal to 3 belongs to the DERIVED
scope.

The rule for UNION is simple: they consume the entire enclosing scope, and to
find the component parts of each one, you find each part's beginning as referred
to in the <unionN,...> definition, and its end is either just before the next
one, or if it's the last part, the end is the end of the scope.

This is only simple because UNION consumes the entire scope, which is either the
entire statement, or the scope of a DERIVED table.  This is because a UNION
cannot be a sibling of another UNION or a table, DERIVED or not.  (Try writing
such a statement if you don't see it intuitively).  Therefore, you can just find
the enclosing scope's boundaries, and the rest is easy.  Notice in the example
above, the UNION is over <union3,5>, which includes the row with id 4 -- it
includes every row between 3 and 5.

Finally, there are non-derived subqueries to deal with as well.  In this case I
can't look at siblings to find the end of the scope as I did for DERIVED.  I
have to trust that MySQL executes depth-first.  Here's an example:

 explain
 select actor_id,
 (
    select count(film_id)
    + (select count(*) from sakila.film)
    from sakila.film join sakila.film_actor using(film_id)
    where exists(
       select * from sakila.actor
       where sakila.actor.actor_id = sakila.film_actor.actor_id
    )
 )
 from sakila.actor;

 | id | select_type        | table      |
 |  1 | PRIMARY            | actor      |
 |  2 | SUBQUERY           | film       |
 |  2 | SUBQUERY           | film_actor |
 |  4 | DEPENDENT SUBQUERY | actor      |
 |  3 | SUBQUERY           | film       |

In order, the tree should be built like this:

=over

=item *

See row 1.

=item *

See row 2.  It's a higher id than 1, so it's a subquery, along with every other
row whose id is greater than 2.

=item *

Inside this scope, see 2 and 2 and JOIN them.  See 4.  It's a higher id than 2,
so it's again a subquery; recurse.  After that, see 3, which is also higher;
recurse.

=back

But the only reason the nested subquery didn't include select 3 is because
select 4 came first.  In other words, if EXPLAIN looked like this,

 | id | select_type        | table      |
 |  1 | PRIMARY            | actor      |
 |  2 | SUBQUERY           | film       |
 |  2 | SUBQUERY           | film_actor |
 |  3 | SUBQUERY           | film       |
 |  4 | DEPENDENT SUBQUERY | actor      |

I would be forced to assume upon seeing select 3 that select 4 is a subquery
of it, rather than just being the next sibling in the enclosing scope.  If this
is ever wrong, then the algorithm is wrong, and I don't see what could be done
about it.

UNION is a little more complicated than just "the entire scope is a UNION,"
because the UNION might itself be inside an enclosing scope that's only
indicated by the first item inside the UNION.  There are only three kinds of
enclosing scopes: UNION, DERIVED, and SUBQUERY.  A UNION can't enclose a UNION,
and a DERIVED has its own "scope markers," but a SUBQUERY can wholly enclose a
UNION, like this strange example on the empty table t1:

 explain select * from t1 where not exists(
    (select t11.i from t1 t11) union (select t12.i from t1 t12));

 |   id | select_type  | table      | Extra                          |
 +------+--------------+------------+--------------------------------+
 |    1 | PRIMARY      | t1         | const row not found            |
 |    2 | SUBQUERY     | NULL       | No tables used                 |
 |    3 | SUBQUERY     | NULL       | no matching row in const table |
 |    4 | UNION        | t12        | const row not found            |
 | NULL | UNION RESULT | <union2,4> |                                |

The UNION's backward references might make it look like the UNION encloses the
subquery, but studying the query makes it clear this isn't the case.  So when a
UNION's first row says SUBQUERY, it is this special case.

By the way, I don't fully understand this query plan; there are 4 numbered
SELECT in the plan, but only 3 in the query.  The parens around the UNIONs are
meaningful.  Removing them will make the EXPLAIN different.  Please tell me how
and why this works if you know.

Armed with this knowledge, it's possible to use recursion to turn the
parent-child relationship between all the rows into a tree representing the
execution plan.

MySQL prints the rows in execution order, even the forward and backward
references.  At any given scope, the rows are processed as a left-deep tree.
MySQL does not do "bushy" execution plans.  It begins with a table, finds a
matching row in the next table, and continues till the last table, when it emits
a row.  When it runs out, it backtracks till it can find the next row and
repeats.  There are subtleties of course, but this is the basic plan.  This is
why MySQL transforms all RIGHT OUTER JOINs into LEFT OUTER JOINs and cannot do
FULL OUTER JOIN.

This means in any given scope, say

 | id   | select_type  | table      |
 |  1   | SIMPLE       | tbl1       |
 |  1   | SIMPLE       | tbl2       |
 |  1   | SIMPLE       | tbl3       |

The execution plan looks like a depth-first traversal of this tree:

       JOIN
      /    \
    JOIN  tbl3
   /    \
 tbl1   tbl2

The JOIN might not be a JOIN.  It might be a subquery, for example.  This comes
from the type column of EXPLAIN.  The documentation says this is a "join type,"
but I think "access type" is more accurate, because it's "how MySQL accesses
rows."

mk-visual-explain decorates the tree significantly more than just turning
rows into nodes.  Each node may get a series of transformations that turn it
into a subtree of more than one node.  For example, an index scan not marked
with 'Using index' must do a bookmark lookup into the table rows; that is a
three-node subtree.  However, after the above node-ordering and scoping stuff,
the rest of the process is pretty simple.

=head1 SEE ALSO

See also L<mk-query-profiler>.

=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 packages that ought to be
installed in any reasonably new version of Perl.

=head1 AUTHOR

Baron "Xaprb" Schwartz.

=head1 COPYRIGHT, LICENSE AND WARRANTY

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 VERSION

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

=cut