#!/usr/local/bin/perl

# Program    : myslow.cgi
# Purpose    : parse, analyze, display, sort MySQL slow query log in HTML
# Copyright  : 2006 James Briggs, San Jose, California, USA.
# License    : GNU General Public Licence (GPL) version 2
# Home       : http://jebriggs.com/myslow.txt
# Screenshot : http://jebriggs.com/myslow.gif
# Env        : Perl5, MySQL 5.0
# Note:      : Apachez suggested to load the slow query log into mysql first,
#              do incremental updates a la awstats and cron.
#              firewire says to do stats (min, avg, max time; freq) on same
#              query with different parms, time of day, etc.
#              Also see http://www.retards.org/projects/mysql/
# Version    : 1.0 2006 05 04 original
#              1.1 2006 05 05 add limit and date parameters
#              1.2 2006 05 06 add tips and regex search, encode td properties
#              1.3 2006 05 07 eval Time::HiRes, eval regex only once if needed
#                             clean up 2 warnings when run from command-line(?)
#                             also look in standard location for mysql-slow
#              1.4 2006 05 08 when sorting by date, sort instead by date+time
#              Please email changes to james.briggs@yahoo.com

use strict;
use diagnostics;

use CGI qw / :standard *table -no_xhtml /;

eval {
   require Time::HiRes;
   Time::HiRes->import(('time'));
};

   my $t0 = time;

### User-defined settings go here ###

   ### Note: some systems use '/var/lib/mysql/mysql-slow.log'

   my $logfile                   = '/var/lib/mysql/mail-slow.log';
   my $title                     = 'MySQL Slow Query Log Viewer';

   use constant LEN_SQL          => 512;

   use constant COLOR_OK         => 'lightgreen';
   use constant COLOR_WARNING    => 'yellow';
   use constant COLOR_CRITICAL   => 'pink';
   use constant COLOR_HEADING    => 'lightblue';

   use constant FLAG_OK         => 0;
   use constant FLAG_WARNING    => 1;
   use constant FLAG_CRITICAL   => 2;

### End of user-defined settings ###

   my $logfile_default = '/var/lib/mysql/mysql-slow.log';
   my $hostname = `hostname`;
   chomp $hostname;
   my $mod_perl = '';
   $mod_perl = ' / mod_perl' if defined $ENV{'MOD_PERL'} and $ENV{'MOD_PERL'} ne '';

   use constant SL_DATE          => 0;
   use constant SL_TIME          => 1;
   use constant SL_USER          => 2;
   use constant SL_HOST          => 3;
   use constant SL_QUERY_TIME    => 4;
   use constant SL_LOCK_TIME     => 5;
   use constant SL_ROWS_SENT     => 6;
   use constant SL_ROWS_EXAMINED => 7;
   use constant SL_SQL           => 8;

   my %labels_sort = (
      '0' => 'Date',
      '1' => 'Time',
      '2' => 'User',
      '3' => 'Host',
      '4' => 'QueryTime',
      '5' => 'LockTime',
      '6' => 'RowsSent',
      '7' => 'RowsExamined',
      '8' => 'SQL',
   );

   my %labels_cb = (
      'adm' => '# administrator command: Execute;<br>',
      'use' => 'use statements<br>',
      'nocache' => 'SQL_NO_CACHE<br>',
   );

   my %labels_st = (
      's' => 'exact',
      'r' => 'regex',
   );

   my $copyright =  <<EOD;
myslow.cgi version 1.4<br>
Copyright 2006, James Briggs, San Jose, California, USA. GPL version 2.<br>
<a href="http://www.ActionMessage.com/">ActionMessage Email Marketing</a>
EOD

    my $tips = <<EOD;
<p>
<table>
<tr>
<td align="left">
<strong>MySQL Query Performance Tips</strong>
<ol>
<li>use the <a href="http://dev.mysql.com/doc/refman/5.0/en/explain.html">EXPLAIN</a> command to see how effective your indexes are
<li>MySQL only uses one index per query. If more than one index would help (for example, OR statements often qualify), rewrite your query as a UNION of two or more queries
<li>improve caching by removing unused surrogate keys
<li>indexes should be as narrow as possible to be cached in memory. try partial-column indexes. for example, most char columns are unique only up to 12 or 15 characters.
<li>however, beware of partial-column indexes - sometimes they are ignored by the query optimizer, resulting in a table scan
<li>do careful performance evaluation of statements using LEFT JOIN (FORCE INDEX may be needed) or subselects (still an immature feature)
<li>more available indexes mean that the query optimizer has more probability of being wrong - double-check with EXPLAIN
<li>try enabling the MySQL query cache. statements must match identically. You can use the /* NO_SQL_CACHE */ to skip results that would pollute the cache. (note that the query cache does not cache results for statements with placeholders)
<li>use numeric indexed columns and fixed-width records (no varchar columns) in busy or long tables (put varchar or blob columns in a separate table)
<li>Read <a href="http://dev.mysql.com/doc/refman/5.0/en/optimization.html">MySQL Manual Chapter 7: Optimization</a>
<li>buy faster hardware: memory, SCSI hard drives and CPUs, in that order.
<li>talk to <a href="http://www.mysql.com/consulting/">MySQL AB Consulting</a> about on-going performance problems
</ol>
</td>
</tr>
</table>
<p>
EOD
   my $in_sort     = param('in_sort')  || SL_DATE;
   my $in_order    = param('in_order') || 'dn';
   my $in_s        = param('in_s')     || '';
   my $in_flag     = param('in_flag')  || 0;
   my $in_suppress = join(',', param('in_suppress'));
      $in_suppress = '' if not defined $in_suppress;
   my $in_limit    = param('in_limit')  || 3000;
   my $in_dt_from  = param('in_dt_from') || '';
   my $in_dt_to    = param('in_dt_to') || '';
   my $in_search_type = param('in_search_type') || '';

   my $pop_sort = popup_menu(-name    => 'in_sort',
                             -values  => [ '0' .. '8'],
                             -labels  => \%labels_sort,
                             -default => $in_sort);

   my $pop_order = popup_menu(-name      => 'in_order',
                              -values    => [ 'up', 'dn' ],
                              -labels    => {
                                    'up' => 'Ascending',
                                    'dn' => 'Descending',
                              },
                              -default     => $in_order);

   my $cb_suppress = checkbox_group(-name     => 'in_suppress',
                                    -values   => [sort keys %labels_cb],
                                    -defaults => [],
                                    -labels   => \%labels_cb);

   $cb_suppress =~ s/&lt;br&gt;/<br>\n/g; # add <br> formatting

   my $radio_search = radio_group(-name   => 'in_search_type',
                                  -values => [reverse sort keys %labels_st],
                                  -labels => \%labels_st,
   );

   print header(),
         start_html( -title => $title . ' - ' . $hostname . $mod_perl,
                     -style => qq|
table { padding: 0px;
        margin: 0px;
}
h1 { font-family: Arial,Helvetica; font-size: 24px; }
p,td { font-family: Arial,Helvetica; font-size: 12px;
}
td { border: 1px solid black; text-align: left; }
.left { text-align: left; }
.right { text-align: right; }
.hilite { background-color: yellow; }
.z { text-align: left; background-color: @{[ COLOR_OK ]}; }
.y { text-align: left; background-color: @{[ COLOR_WARNING ]}; }
.x { text-align: left; background-color: @{[ COLOR_CRITICAL ]}; }
.w { text-align: right; background-color: @{[ COLOR_OK ]}; }
.v { text-align: right; background-color: @{[ COLOR_WARNING ]}; }
.u { text-align: right; background-color: @{[ COLOR_CRITICAL ]}; }
|);

   print CGI::center(),"\n",
         start_form(),"\n",
         start_table(),"\n",
         Tr( { -bgcolor => COLOR_HEADING }, td( { -colspan => 2}, CGI::center(strong($title)) )),"\n",
         Tr( td( { -align => 'left' }, ['Sort By:', $pop_sort . $pop_order])),"\n",
         Tr( td( { -align => 'left' }, [ 'Suppress:', $cb_suppress ])),"\n",
         Tr( td( { -align => 'left' }, [ 'Limit:', textfield( -name => 'in_limit', -default => $in_limit, -size => 5, -style => 'text-align: right;') . ' rows displayed' ])),"\n",
         Tr( td( { -align => 'left' }, ['Date Range:', 'From: ' . textfield( -name => 'in_dt_from', -size => 8, -maxlength => 8) . ' To: ' . textfield( -name => 'in_dt_to', -size => 8, -maxlength => 8) . ' (yyyymmdd)' ])),"\n",
         Tr( td( { -align => 'left' }, ['Search SQL:', textfield( -name => 'in_s', -default => $in_s,  -size => 20) . $radio_search ])),"\n",
         end_table(),"\n",
         p(),"\n",
         hidden('in_flag', 1),"\n",
         submit('submit', 'Display'),"\n",
         end_form(),"\n",
         p(),"\n";

   if ($in_s ne '' and $in_search_type eq 'r') {
      eval { 'test' =~ /$in_s/ }; # validate regex syntax
      if ($@) {
         print "Error: likely invalid perl regular expression syntax. Please try again.\n",
            end_html();
         exit 1;
      }
   }

if ($in_flag) {
   my ($date, $time, $user, $host, $query_time, $lock_time, $rows_sent, $rows_examined, $sql);

   my $n = 0;
   my $start = 1;

   if (! -e $logfile) {
      if (-e $logfile_default) {
         $logfile = $logfile_default;
      }
      else {
         print "error: file not found " . $logfile;
         print end_html();
         exit 1;
      }
   }

   open X, "<@{[ $logfile ]}" or do {
      print "error: cannot open file " . $logfile;
      print end_html();
      exit 1;
   };
   binmode(X);

   my @events;

   while (<X>) {
      chomp;
      $n++;
      next if /^$/ or /^Tcp port:/ or /Version:/ or /^Time/;

# Time: 060404  4:03:47
      if (/^# Time: (\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)/) {
         my $ndate = "20$1$2$3";
         my $ntime = "$4$5$6";
         $ntime = '0' . $ntime if 5 == length $ntime;
         
         my $in_s_esc = $in_s;
         if ($in_search_type eq 's') {
            $in_s_esc =~ s/([\[\])(*.+?])/\\$1/g;
         }

         my $match;

         if (!$start and !suppressed($sql, $in_suppress) and
             ($in_dt_from eq '' or $date >= $in_dt_from) and
             ($in_dt_to eq '' or $date <= $in_dt_to) and
             ($in_s eq '' or ($in_s ne '' and $sql =~ /$in_s_esc/i) )) {

               $sql =~ s/($in_s_esc)/<span class="hilite">$1<\/span>/ig if $in_s ne '';
            $sql = escapeHTML($sql);
            $sql =~ s/&lt;span class=&quot;hilite&quot;&gt;/<span class="hilite">/g;
            $sql =~ s/&lt;\/span&gt;/<\/span>/g;
            push @events, [ $date, $time, $user, $host, $query_time, $lock_time, $rows_sent, $rows_examined, $sql ];
         }

         $start = 0;

         $date = $ndate;
         $time = $ntime;

         $user = '';
         $host = '';
         $query_time    = 0;
         $lock_time     = 0;
         $rows_sent     = 0;
         $rows_examined = 0;
         $sql           = '';
      }
      elsif (/ User\@Host: (.*?) \@ (.*?) /) {
         $user = $1;
         $host = $2;
      }
      elsif (/Query_time: (\d+)  Lock_time: (\d+)  Rows_sent: (\d+)  Rows_examined: (\d+)/) {
         $query_time    = $1;
         $lock_time     = $2;
         $rows_sent     = $3;
         $rows_examined = $4;
      }
      elsif (/^SET /i) {
         ;
      }
      else {
         $sql .= $_;
      }
   }

   close X;

# 411 - need to apply escapeHTML(), but not to the hilite span

   my $in_s_esc = $in_s;
   if ($in_search_type eq 's') {
      $in_s_esc =~ s/([\[\])(*.+?])/\\$1/g;
   }

   if (!suppressed($sql, $in_suppress) and
      ($in_dt_from eq '' or $date >= $in_dt_from) and
      ($in_dt_to eq '' or $date <= $in_dt_to) and
      ($in_s eq '' or ($in_s ne '' and $sql =~ /$in_s_esc/i))) {

      $sql =~ s/($in_s_esc)/<span class="hilite">$1<\/span>/ig if $in_s ne '';
      $sql = escapeHTML($sql);
      $sql =~ s/&lt;span class=&quot;hilite&quot;&gt;/<span class="hilite">/g;
      $sql =~ s/&lt;\/span&gt;/<\/span>/g;
      push @events, [ $date, $time, $user, $host, $query_time, $lock_time, $rows_sent, $rows_examined, $sql ];
   }

   if (scalar @events) {
      $n = 1;
      print start_table(),
         Tr( { -bgcolor => COLOR_HEADING }, td( { class => 'right' }, 'n'), td(['Date', 'Time', 'QueryTime', 'LockTime', 'RowsSent', 'RowsExamined', 'User', 'Host', 'SQL']));

      my $sub;

      if ($in_sort == SL_DATE) {
         if ($in_order eq 'up') { # 411 - assuming rows are in chrono order
            foreach my $event (@events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
         else {
            foreach my $event (sort { $b->[SL_DATE].$b->[SL_TIME] <=> $a->[SL_DATE].$a->[SL_TIME] } @events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
      }
      elsif ($in_sort == SL_USER ||
          $in_sort == SL_HOST ||
          $in_sort == SL_SQL) {

         if ($in_order eq 'up') {
            foreach my $event (sort { uc($a->[$in_sort]) cmp uc($b->[$in_sort]) } @events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
         else {
            foreach my $event (sort { uc($b->[$in_sort]) cmp uc($a->[$in_sort]) } @events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
      }
      else {
         if ($in_order eq 'up') {
            foreach my $event (sort { $a->[$in_sort] <=> $b->[$in_sort] } @events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
         else {
            foreach my $event (sort { $b->[$in_sort] <=> $a->[$in_sort] } @events) { print row($event, $n++), "\n"; last if $n > $in_limit; }
         }
      }
      print end_table();
   }
   else {
      print "No log entries found.";
   }
}
else {
   print $tips;
}

   my $t1 = time;

   print p(),"\n",
         $copyright,"\n",
         p(),"\n",
         sprintf("%.3f %s\n", $t1 - $t0, 's'),
         end_html();

sub suppressed {
   my ($sql, $s) = @_;

   if ($s ne '') {
      return 1 if $s =~ /adm/     and $sql =~ /^# administrator command: Execute;/i;
      return 1 if $s =~ /use/     and $sql =~ /^use /i;
      return 1 if $s =~ /nocache/ and $sql =~ / SQL_NO_CACHE /i;
   }

   0;
}

sub print_date {
   my ($dt, $style) = @_;

    my ($year, $mon, $mday, $hour, $min, $sec) = $dt =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;

     if ($style == 1) {
        sprintf '%04d-%02d-%02d',$year,$mon,$mday;
     }
     elsif ($style == 2) {
        sprintf '%02d:%02d:%02d',$hour,$min,$sec;
     }
     else {
        sprintf '%04d-%02d-%02d %02d:%02d:%02d',$year,$mon,$mday,$hour,$min,$sec;
     }
}

sub commify {
   my ($s, $locale) = @_;
   return $s if $s =~ /,/; # don't re-commify

   my $text = reverse $s;

   $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;

   return scalar reverse $text;
}

sub row {
   my ($e, $n) = @_;

   my $sql = '';

   if (LEN_SQL <= length $e->[ SL_SQL ]) {
      $sql = substr($e->[ SL_SQL ], 0, LEN_SQL) . '...';
   }
   else {
      $sql = $e->[ SL_SQL ];
      $sql = '&nbsp;' if $sql eq '';
   }

   my $html = Tr(
      td( { class => 'right' }, $n),
      td( print_date($e->[ SL_DATE ] . $e->[ SL_TIME ],1)),
      td( print_date($e->[ SL_DATE ] . $e->[ SL_TIME ],2)),
      td( { class => 'right', -bgcolor => score_query_time($e->[ SL_QUERY_TIME ]) }, commify($e->[ SL_QUERY_TIME ])),
      td( { class => 'right', -bgcolor => score_lock_time($e->[ SL_LOCK_TIME ]) }, commify($e->[ SL_LOCK_TIME ])),
      td( { class => 'right', -bgcolor => score_rows_sent($e->[ SL_ROWS_SENT ], $e->[ SL_ROWS_EXAMINED ], $sql) }, commify($e->[ SL_ROWS_SENT ])),
      td( { class => 'right', -bgcolor => score_rows_examined($e->[ SL_ROWS_EXAMINED ]) }, commify($e->[ SL_ROWS_EXAMINED ])),
      td( $e->[ SL_USER ]),
      td( { class => 'left', -bgcolor => score_host($e->[ SL_HOST ]) }, $e->[ SL_HOST ]),
      td( $sql),
   );

# encode td properties aggressively

   my %abbrev = ( 'left0'  => 'z',
                  'left1'  => 'y',
                  'left2'  => 'z',
                  'right0' => 'w',
                  'right1' => 'v',
                  'right2' => 'u' );

   $html =~ s/bgcolor="(.*?)" class="(.*?)"/class=$abbrev{"$2$1"}/g;
   $html =~ s|</td> |</td>|g;

   $html;
}

sub score_query_time {
   my ($s) = @_;

   return FLAG_CRITICAL if $s >= 5;
   return FLAG_OK       if $s == 0; # unlikely in slow query log
   return FLAG_WARNING;
}

sub score_lock_time {
   my ($s) = @_;

   return FLAG_OK       if $s == 0;
   return FLAG_CRITICAL if $s > 1;
   return FLAG_WARNING;
}

sub score_rows_sent {
   my ($sent, $examined, $sql) = @_;

   return FLAG_OK       if $sent == $examined and $sent < 100;
   return FLAG_OK       if $sent == 1 and $sql =~ /count/i;

   return FLAG_CRITICAL if ($examined != 0) and ( (0.5 > $sent / $examined) or ($sent == $examined) );
   return FLAG_WARNING;
}

sub score_rows_examined {
   my ($examined) = @_;

# 411 - better scores if we had table counts, maybe

   return FLAG_CRITICAL if $examined >= 100;
   return FLAG_OK       if $examined <= 1;
   return FLAG_WARNING;
}

sub score_host {
   my ($host) = @_;

   return FLAG_OK       if $host eq 'localhost';
   return FLAG_WARNING;
}