#!/usr/local/bin/perl

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

# This is mysql-heartbeat, a script to measure replication delay.
#
# This program is copyright (c) 2006 Proven Scaling LLC and SixApart Ltd, and
# (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(min max sum);
use Term::ReadKey;
use Time::HiRes qw(ualarm gettimeofday);

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

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

# Define cmdline args; each is GetOpt::Long spec and human-readable description.
my @opt_spec = (
   { s => 'askpass',           d => 'Prompt for password for connections' },
   { s => 'check',             d => 'Check slave delay once and exit' },
   { s => 'daemonize',         d => 'Fork to background and detach (POSIX only)' },
   { s => 'database|D=s',      d => 'Database to use' },
   { s => 'defaults-file|F=s', d => 'Only read default options from the given file' },
   { s => 'file=s',            d => 'Print latest --monitor output to this file' },
   { s => 'frames=s',          d => 'Timeframes for averages (default 1m,5m,15m)' },
   { s => 'help',              d => 'Show this help message' },
   { s => 'host|h=s',          d => 'Connect to host' },
   { s => 'monitor',           d => 'Monitor slave delay continuously' },
   { 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 => 'table|t=s',         d => 'Table to use for heartbeat (default heartbeat)' },
   { s => 'update',            d => "Update a master's heartbeat" },
   { s => 'user|u=s',          d => 'User for login if not current user' },
   { s => 'version',           d => 'Output version information and exit' },
);

my %opts = (
   t       => 'heartbeat',
   update  => 0,
   check   => 0,
   monitor => 0,
   frames  => '1m,5m,15m',
);

# 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 ( !$opts{help} ) {
   if ( $opts{monitor} + $opts{update} + $opts{check} != 1 ) {
      warn "You must use one and only one of --update, --monitor, or --check\n";
      $opts{help} = 1;
   }

   # Parse the timeframe specification
   my @frames = $opts{frames} =~ m/(\d+[smhd])/g;
   if ( @frames ) {
      $opts{frames} = [];
      foreach my $frame ( @frames ) {
         my ($num, $suf ) = $frame =~ m/(\d+)([smhd])$/;
         if ( !$num ) {
            warn "Invalid --frames argument\n";
            $opts{help} = 1;
         }
         else {
            push @{$opts{frames}}, 
                 $suf eq 's' ? $num            # Seconds
               : $suf eq 'm' ? $num * 60       # Minutes
               : $suf eq 'h' ? $num * 3600     # Hours
               :               $num * 86400;   # Days
         }
      }
   }
   else {
      warn "Invalid --frames argument\n";
      $opts{help} = 1;
   }
}

if ( $opts{help} ) {
   print "Usage: $PROGRAM_NAME <options> {--update|--monitor|--check}\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;

      mysql-heartbeat measures replication lag.  You can use it to update a
      master or monitor a slave.  If possible, connection options are read from
      your .my.cnf file.  For more details, please read the documentation:

         perldoc mysql-heartbeat

   USAGE
   print $usage;
   exit(0);
}

# ############################################################################
# Work.
# ############################################################################
my $update_sql = "UPDATE $opts{t} SET ts=NOW() WHERE id=1";
my $select_sql = "SELECT UNIX_TIMESTAMP()-UNIX_TIMESTAMP(ts) AS delay FROM $opts{t} WHERE id=1";
my $dbh = get_dbh(); # Connect before daemonizing so --askpass works.
my $sth = $dbh->prepare($opts{update} ? $update_sql : $select_sql);

# Do a little check just to make sure the table is there, so there's one last
# chance to catch errors before daemonizing.
$sth->execute();
$sth->finish();

# Daemonize only after (potentially) asking for passwords for --askpass.
if ( $opts{daemonize} ) {
   require POSIX;
   chdir '/'                 or die "Can't chdir to /: $OS_ERROR";
   open STDIN, '/dev/null'   or die "Can't read /dev/null: $OS_ERROR";
   open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $OS_ERROR";
   defined( my $pid = fork ) or die "Can't fork: $OS_ERROR";
   exit if $pid;
   POSIX::setsid()           or die "Can't start a new session: $OS_ERROR";
   open STDERR, '>&STDOUT'   or die "Can't dup STDOUT: $OS_ERROR";
}

# Setup for moving averages.
my @samples;
my $limit  = max(@{$opts{frames}});
my $format = "%4ds [ " . join(", ", map { "%5.2fs" } @{$opts{frames}}) . " ]\n";

# This handler will do nothing but wake us up from sleep();
$SIG{ALRM} = sub {};

# Set up an alarm.  --update alarms happen on the second boundary, and
# --monitor alarms happen halfway between seconds.
ualarm(( ($opts{update} ? 1_000_000 : 1_500_000) - (gettimeofday)[1] ), 1_000_000);

while ( 1 ) {

      eval {
      # Normally it is not safe to use sleep and alarm together, but since we're
      # sleeping an infinite time and waiting for the alarm to wake us up,
      # there's no harm in it.  In other words, infinite sleep isn't implemented
      # with alarm.
      sleep;

      # Connect or reconnect if necessary.
      if ( !$dbh->ping ) {
         $dbh = get_dbh();
         $sth = undef;
      }

      if ( $opts{monitor} || $opts{check} ) {

         # Get the data
         $sth ||= $dbh->prepare($select_sql);
         $sth->execute;
         my ( $delay ) = $sth->fetchrow_array;
         unshift @samples, $delay;
         pop @samples if @samples > $limit;

         # Calculate and print results
         if ( $opts{check} ) {
            print "$delay\n";
            exit(0);
         }
         else {
            my @vals = map {
               my $bound = min($_, scalar(@samples));
               sum(@samples[0 .. $bound-1]) / $_;
            } @{$opts{frames}};
            my $output = sprintf($format, $delay, @vals);
            if ( $opts{file} ) {
               open my $file, ">", $opts{file}
                  or die "Can't open $opts{file}: $OS_ERROR";
               print $file $output
                  or die "Can't print to  $opts{file}: $OS_ERROR";
               close $file or die "Can't close $opts{file}: $OS_ERROR";
            }
            else {
               print $output;
            }
         }
      }

      else { # --update mode
         $sth ||= $dbh->prepare($update_sql);
         $sth->execute;
      }
   };
   if ( $EVAL_ERROR ) {
      my ( $err ) = $EVAL_ERROR =~ m/^(?:DBI|DBD).*failed: (.*?)\s*at \S+ line .*/;
      if ( $err ) {
         print STDERR $err, "\n";
      }
      else {
         die $EVAL_ERROR;
      }
   }
}

# ############################################################################
# Subroutines
# ############################################################################
sub get_dbh {
   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 } );
   $dbh->{InactiveDestroy}  = 1;         # Don't disconnect on fork
   return $dbh;
}

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

=pod

=head1 NAME

mysql-heartbeat - Monitor MySQL replication delay.

=head1 SYNOPSIS

 mysql-heartbeat -D test --update -h master-server
 mysql-heartbeat -D test --monitor -h slave-server

=head1 DESCRIPTION

MySQL Heartbeat is a two-part MySQL replication delay monitoring system that
doesn't require the slave SQL thread to be running.  The first part updates a
timestamp every second on the master.  You must create a table on the master
as follows:

 CREATE TABLE heartbeat (
   id int NOT NULL PRIMARY KEY,
   ts datetime NOT NULL
 );
 INSERT INTO heartbeat(id) VALUES(1);

Now you connect MySQL Heartbeat to the master and run it in L<"--update"> mode
to generate the heartbeat.  This completes the first part.

The second part is to monitor the slave's delay with L<"--monitor"> or
L<"--check">.  This works even on daisy-chained slaves to any depth.

MySQL Heartbeat has a one-second resolution.  It depends on the clocks on the
master and slave servers being closely synchronized via NTP.  L<"--update">
checks happen on the edge of the second, and L<"--monitor"> checks happen
halfway between seconds.  As long as the servers' clocks aren't skewed much
and the replication events are propagating in less than half a second, MySQL
Heartbeat will report zero seconds of delay.

MySQL Heartbeat will try to reconnect if the connection has an error, but will
not retry if it can't get a connection when it first starts.

=head1 OPTIONS

=over

=item --askpass

Prompts the user for a password when connecting to MySQL.

=item --check

Reports slave delay and exits.

=item --daemonize

Fork to the background and detach from the shell.  This probably doesn't work
on Microsoft Windows.

=item --database

The database to use for the connection.

=item --defaults-file

Only read default options from the given file.  You must give an absolute
pathname.

=item --file

When L<"--monitor"> is given, prints output to the specified file instead of to
STDOUT.  The file is opened, truncated, and closed every second, so it will only
contain the most recent statistics.  Useful when L<"--daemonize"> is given.

=item --frames

Specifies the timeframes over which to calculate moving averages when
L<"--monitor"> is given.  The default value is one, five and fifteen minutes.
Specify as a comma-separated list of numbers with suffixes.  The suffix can be s
for seconds, m for minutes, h for hours, or d for days.  The size of the largest
frame determines the maximum memory usage, as up the specified number of
per-second samples are kept in memory to calculate the averages.  You can
specify as many timeframes as you like.

=item --help

Displays a help message.

=item --host

Connect to host.

=item --monitor

Specifies that mysql-heartbeat should check the slave's delay every second and
report to STDOUT (or if L<"--file"> is given, to the file instead).  The output
is the current delay followed by moving averages over the timeframe given in
L<"--frames">.  For example,

 5s [  0.25s,  0.05s,  0.02s ]

=item --password

Password to use when connecting.

=item --port

Port number to use for connection.

=item --socket

Socket file to use for connection.

=item --table

The table to use for the heartbeat.  The default is 'heartbeat'.  Don't
specify database.table; use L<"--database"> to specify the database.

=item --update

Assumes the server is a master and updates the heartbeat every second.

=item --user

User for login if not current user.

=item --version

Output version information and exit.

=back

=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 SEE ALSO

See also L<mysql-slave-delay> and L<mysql-slave-restart>.

=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 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright (c) 2006 Proven Scaling LLC and SixApart Ltd, and
(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

Proven Scaling LLC, SixApart Ltd, and Baron Schwartz.

=head1 VERSION

This manual page documents Ver 1.0.1 Distrib 1053 $Revision: 940 $.

=cut