#!/usr/bin/perl

# This program tests a MySQL server against the MySQL option and variable
# reference.
#
# 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 List::Util qw(max);
use Term::ReadKey;
use HTML::TableExtract;
use WWW::Mechanize;

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

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

# Define cmdline args; each is GetOpt::Long spec, whether required,
# human-readable description.  Add more hash entries as needed.
my @opt_spec = (
   { s => 'askpass',           d => 'Prompt for password for connections' },
   { s => 'database|D=s',      d => 'Database to use' },
   { s => 'defaults-file|F=s', d => 'Only read default options from the given file' },
   { s => 'host|h=s',          d => 'Connect to host' },
   { s => 'help',              d => 'Show this help message' },
   { s => 'password|p=s',      d => 'Password to use when connecting' },
   { s => 'port|P=i',          d => 'Port number to use for connection' },
   { s => 'socket|S=s',        d => 'Socket file to use for connection' },
   { s => 'user|u=s',          d => 'User for login if not current user' },
   { s => 'version',           d => 'Output version information and exit' },
);

# This is the container for the command-line options' values to be stored in
# after processing.  Initial values are defaults.
my %opts;
# 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 "$PROGRAM_NAME  Ver $VERSION Distrib $DISTRIB Changeset $SVN_REV\n";
   exit(0);
}

# If a filename or other argument(s) is required after the other arguments,
# add "|| !@ARGV" inside the parens on the next line.
if ( $opts{help} ) {
   print "Usage: $PROGRAM_NAME <options> batch-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});
   }
   (my $usage = <<"   USAGE") =~ s/^      //gm;

      $PROGRAM_NAME tests MySQL's option table reference
      (http://dev.mysql.com/doc/en/mysqld-option-tables.html).

      If possible, database options are read from your .my.cnf file.
      For more details, please read the documentation:

         perldoc $PROGRAM_NAME

   USAGE
   print $usage;
   exit(0);
}

# ############################################################################
# Get ready to do the main work.
# ############################################################################
my %conn = (
   F => 'mysql_read_default_file',
   h => 'host',
   P => 'port',
   S => 'mysql_socket'
);

# Connect to the database
if ( !$opts{p} && $opts{askpass} ) {
   print "Enter password: ";
   ReadMode('noecho');
   chomp($opts{p} = <STDIN>);
   ReadMode('normal');
   print "\n";
}

my $dsn = 'DBI:mysql:' . ( $opts{D} || '' ) . ';'
   . join(';', map  { "$conn{$_}=$opts{$_}" } grep { defined $opts{$_} } qw(F h P S))
   . ';mysql_read_default_group=mysql';
my $dbh = DBI->connect($dsn, @opts{qw(u p)}, { AutoCommit => 1, RaiseError => 1, PrintError => 0 } );

# Get the version and decide which URL to fetch
my $version = sprintf('%d.%d', $dbh->{mysql_serverinfo} =~ m/(\d+)/g);
my $fullver = sprintf('%d.%d.%d', $dbh->{mysql_serverinfo} =~ m/(\d+)/g);

my $url_ver = $version lt '5.0' ? '4.1'
            : $version eq '5.0' ? '5.0'
            : $version eq '5.1' ? '5.1'
            : undef;

die "Ack, I'm not able to deal with version $version" unless $url_ver;

print "Testing table for $url_ver against MySQL $fullver\n";

my $url = "http://dev.mysql.com/doc/refman/$url_ver/en/mysqld-option-tables.html";

my $m = WWW::Mechanize->new();
$m->get($url);

my $te = HTML::TableExtract->new();
$te->parse($m->content);

my ($table) = $te->tables(); # Praise God, they don't use tables for layout.
my @rows = $te->rows;
shift @rows; # headers

my %options;
foreach my $row (@rows) {
   my ($varname) = $row->[0] =~ m/([\w-]+$)/;
   my %hash;
   @hash{qw(name cmd_line option_file system_var status_var var_scope dynamic)}
      = @$row;
   $options{$varname} = \%hash;
}

my %vars = %{ $dbh->selectall_hashref('show variables', 'Variable_name') };
my %stat = %{ $dbh->selectall_hashref('show status', 'Variable_name') };

# Look for ones not covered
foreach my $key ( sort keys %vars ) {
   print "Undocumented system variable $key\n"
      unless exists $options{$key};
}
foreach my $key ( sort keys %stat ) {
   print "Undocumented status variable $key\n"
      unless exists $options{$key};
}

# Verify the scope of system variables (it's pretty hard to verify the scope of
# status variables).
foreach my $option ( sort keys %options ) {
   my $def = $options{$option};
   (my $var = $option) =~ tr/-/_/;

   # See if it's a server variable.
   my ($is_global_var, $is_session_var, $can_global_set, $can_session_set);
   if ( $var eq $option || !exists $options{$var} ) {
      eval {
         $dbh->do('SELECT @@global.' . $var);
         $is_global_var = 1;
         $dbh->do('SET @@global.' . $var . ' := @@global.' . $var);
         $can_global_set = 1;
      };
      eval {
         $dbh->do('SELECT @@session.' . $var);
         $is_session_var = 1;
         $dbh->do('SET @@session.' . $var . ' := @@session.' . $var);
         $can_session_set = 1;
      };
   }

   # Check the scope and dynamism of the system variable
   if ( $def->{system_var} eq 'Y' ) {

      # Global
      if ( $def->{var_scope} =~ m/global|both/ && !$is_global_var ) {
         print "System variable $option is not a global variable\n";
      }
      if ( $def->{var_scope} !~ m/global|both/ && $is_global_var ) {
         print "System variable $option is a global variable\n";
      }
      if ( $def->{dynamic} =~ m/yes/ && !$can_global_set ) {
         print "System variable $option is not global dynamic\n";
      }
      if ( $def->{dynamic} =~ m/no/ && $can_global_set ) {
         print "System variable $option is global dynamic\n";
      }

      # Session
      if ( $def->{var_scope} =~ m/session|both/ && !$is_session_var ) {
         print "System variable $option is not a session variable\n";
      }
      if ( $def->{var_scope} !~ m/session|both/ && $is_session_var ) {
         print "System variable $option is a session variable\n";
      }
      if ( $def->{dynamic} =~ m/yes/ && !$can_session_set ) {
         print "System variable $option is not session dynamic\n";
      }
      if ( $def->{dynamic} =~ m/no/ && $can_session_set ) {
         print "System variable $option is session dynamic\n";
      }
   }

   if ( $def->{system_var} eq 'Y' && !defined $vars{$option} && !defined $vars{$var} ) {
      print "No such system variable $option\n";
   }

   if ( $def->{status_var} eq 'Y' && !defined $stat{$option} ) {
      print "No such status variable $option\n";
   }

}