#!/usr/local/bin/perl

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

# This is mysql-profile-compact, a program to align results from
# mysql-query-profiler side by side for comparison.
# 
# 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';

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

our $VERSION = '1.1.5';
our $DISTRIB = '1053';
our $SVN_REV = sprintf("%d", q$Revision: 655 $ =~ m/(\d+)/g);

$OUTPUT_AUTOFLUSH = 1;

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

my @opt_spec = (
   { s => 'help',        d => 'Show help text' },
   { s => 'queries|q=s', d => 'Only do these queries (e.g. 2,4,6)' },
   { s => 'mode|m=s',    d => 'Mode: what type of reports to process' },
   { s => 'headers|h=i', d => 'Reprint headers every N queries' },
   { s => 'version',     d => 'Output version information and exit' },
);

my %opts = (
   h => 2000,
);

# Post-process...
my %opt_seen;
foreach my $spec ( @opt_spec ) {
   my ( $long, $short ) = $spec->{s} =~ m/^(\w+)(?:\|([^!+=]*))?/;
   $spec->{k} = $short || $long;
   $spec->{l} = $long;
   $spec->{t} = $short;
   $spec->{n} = $spec->{s} =~ m/!/;
   $opts{$spec->{k}} = undef unless defined $opts{$spec->{k}};
   die "Duplicate option $spec->{k}" if $opt_seen{$spec->{k}}++;
}

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

if ( $opts{version} ) {
   print "mysql-profile-compact  Ver $VERSION Distrib $DISTRIB Changeset $SVN_REV\n";
   exit(0);
}

# Post-post-process...
if ( $opts{q} ) {
   $opts{q} = { map { $_ => 1 } $opts{q} =~ m/(\d+)/g };
}

if ( $opts{help} ) {
   print "Usage: mysql-profile-compact <options>... [FILE]...\n\n";
   my $maxw = max(map { length($_->{l}) + ($_->{n} ? 4 : 0)} @opt_spec);
   foreach my $spec ( sort { $a->{l} cmp $b->{l} } @opt_spec ) {
      my $long  = $spec->{n} ? "[no]$spec->{l}" : $spec->{l};
      my $short = $spec->{t} ? "-$spec->{t}" : '';
      printf("  --%-${maxw}s %-4s %s\n", $long, $short, $spec->{d});
   }
   print <<USAGE;

mysql-profile-compact aligns query profiler results side by side for easy
comparison.  With no FILE, or when FILE is -, read from standard input.

For more details, please read the documentation:

   perldoc mysql-profile-compact

USAGE
   exit(0);
}

# ############################################################################
# Get ready to do the main work.
# ############################################################################

my @report;
my @header;
my $query = 0;      # query
my $mode  = '';     # mode: start, query, body
my $lnum  = 0;      # line number
my $tw    = 0;      # width of normal text
my $left  = 100;    # where to cut off the text
my $right = 0;      # how many chars to cut
my $seen  = 0;

LINE:
while ( my $line = <> ) {
   chomp $line;
   next unless $line;

   if ( $line =~ m/---/ ) {
      $mode = $mode eq 'b' ? 's'
            : $mode eq ''  ? 's'
            :                'q';
      next LINE;
   }

   if ( $mode eq 's' && $line =~ m/(EXTERNAL|SUMMARY|QUERY)(?: (\d+))?/ ) {
      $opts{m} ||= $1;

      if ( ( $opts{m} ne $1 ) || ($2 && $opts{q} && !$opts{q}->{$2}) ) {
         $mode = '' if $opts{m} ne $1;  # Skip until next header
         next LINE;
      }
      $seen++; # Wait until after deciding to process/skip
      $query = $2 || $seen;

      if ( $seen == 2 ) { # First report is completely read
         # Figure out where to 'cut' all subsequent reports.
         $tw   = max(map { length($_) } @report);
         map {
            $left = $_ =~ m/^(\D+)\d/        ? min(length($1), $left)
                  : $_ =~ m/^(__[^_]+_*?)_ / ? min(length($1), $left)
                  :                            $left;
         } @report;
         $right = $tw - $left;
      }

      # Normalize the width of all report lines.
      my $width = $seen == 2 ? $tw : max(map { length($_) } @report);
      @report = map {
         length($_) == $width ? $_ : sprintf("%-${width}s", $_);
      } @report;

      if ( $seen == 1 || ($seen - 1 ) % $opts{h} == 0 ) {
         push @header, sprintf("%-${tw}s", "$1 $query");
      }
      else {
         push @header, sprintf("%-${right}s", "$1 $query");
      }
      next LINE;
   }

   if ( $mode eq 'q' && $line =~ m/__ Overall/ ) {
      $mode = 'b';
      $lnum = 0;
      # next LINE; This line needs to be processed, don't skip.
   }

   if ( $mode eq 'b' ) {
      if ( $seen == 1 ) {    # First report: build labels
         push @report, $line;
      }
      elsif ( $lnum < @report ) {    # Subsequent reports: tack onto right
         if ( ($seen - 1 ) % $opts{h} == 0 ) {
            $report[$lnum] .= sprintf( "|%${tw}s", $line );
         }
         else {
            $line =~ s/^.{$left}//;                                # Chop the start
            $line =~ s/^([ a-zA-Z]+)(?=__)/'_' x length($1)/e;     # Snip leftovers in headings
            $line =~ s/(\D*)(?=\d)/(' ' x length($1))/e;           # Zap non-digits
            $line =~ s/^ *([ A-Za-z]+) *$/(' ' x length($1))/e;    # Blank out sub-headings
            $report[$lnum] .= sprintf( "|%-${right}s", $line );
         }
      }
      $lnum++;
   }

}

# Must fix up the first header, because it was pushed onto the array before $tw
# was known.  Plus I want it aligned a bit differently.
$header[0] = sprintf("%-${tw}s", (' ' x $left) . $header[0]);
print join('|', @header), "\n", join("\n", @report), "\n";

# ############################################################################
# Perldoc
# ############################################################################

=pod

=head1 NAME

mysql-profile-compact - Compact the output from mysql-query-profiler.

=head1 SYNOPSIS

To view queries 2, 4 and 6 side by side:

   mysql-profile-compact -q 2,4,6 profile-results.txt

To view summaries from two runs side by side:

   mysql-profile-compact -m SUMMARY results-1.txt results-2.txt

=head1 DESCRIPTION

mysql-profile-compact slices and aligns the output from mysql-query-profiler
so you can compare profile results side by side easily.  It prints the first
profile result intact, but each subsequent result is trimmed to be as narrow
as possible, then aligned next to the first.

You can also use this to examine only some profile results.  For example, if
you have a set of queries to get a table into a known state, and then a query
you want to profile, you can ignore the setup queries.  This is typically easy
to do with a command-line option like L<"--queries"> 4,8,12,16,20 to view
every 4th query.

If the first profile it sees is labeled QUERY X, it will only look at QUERY
profiles from then on.  The same holds for SUMMARY profiles.  This is because
there are different numbers of lines in QUERY and SUMMARY profiles.  You can
specify which kind of profile result you want to process.  See
L<mysql-query-profiler> for the full list of types.

=head1 OPTIONS

=over

=item --help

Displays a help message.

=item --queries

Specify a comma-separated list of queries to process; others will be ignored.

=item --mode

Specifies what type of reports (EXTERNAL, QUERY, SUMMARY) to process.

=item --headers

Reprints the headers every N queries.

=item --version

Output version information and exit.

=back

=head1 BUGS

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

=head1 SEE ALSO

See also L<mysql-query-profiler>.

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

This manual page documents Ver 1.1.5 Distrib 1053 $Revision: 655 $.

=cut