#!/usr/bin/perl
### (c) 2009, Marco Fontani <MFONTANI@cpan.org>
### The following code is released for the Public Domain.
use strict;
use warnings;
use CGI;
use DBI;
use DateTime;
use DateTime::TimeZone;
use POSIX qw/strftime/;
use 5.010_000;

=head1 NAME

mysqltime.cgi - Shows differences between local time/timezone and remote mysql server's time/timezone

=head1 DESCRIPTION

Connects to a default or query parameters-specified MySQL server, using DBI.
Gathers the MySQL server time since the Epoch, and the MySQL server timezone.
Shows the difference in Epoch time between the server hosting the CGI and the MySQL server.
Shows the date/time and timezone information of both the server hosting the CGI and the MySQL server.
Shows the difference between the two timezones, and the difference in time when the timezones are
taken into consideration.

=head1 REQUIRES

The following Perl versions and modules are required and should be available:

Perl 5.010_000 ( for the defined-or // operator )
POSIX (core)
DBI
DBD::mysql
DateTime
DateTime::TimeZone

=head1 DEPLOYMENT

  Ensure Apache can run Perl CGIs from /usr/lib/cgi-bin
  aptitude install libdbd-mysql-perl libdatetime-perl libdatetime-timezone-perl
  Drop file on /usr/lib/cgi-bin/
  Make file executable via chmod +x

=head1 PRIVATE METHODS

=over 8

=item __offset

  __offset( $time );

Shortcut sub, returns the system's offset from UTC as a string, in the format
C<[+-]HH:MM:SS>, using C<DateTime> and C<DateTime::TimeZone>; uses C<$ENV{'TZ'}>
if defined.

May be replaced by C<strftime('%z', time)> on systems which support the C<%z> strftime
modifier.

=cut

sub __offset {
  my $time   = shift;
  my $tz     = strftime( '%Z', localtime $time );                       # fallback timezone
  my $dt     = DateTime->from_epoch( epoch => $time );                  # time in UTC
  my $dttz   = DateTime::TimeZone->new( name => $ENV{'TZ'} // $tz );    # Use TZ or fallback
  my $offset = $dttz->offset_for_datetime($dt);                         # in seconds
  return sprintf(
    '%s%02d:%02d:%02d',                                                 # [+-]HH:MM:SS
    $offset >= 0 ? '+' : '-',
    abs int( $offset / 60 / 60 ),    # taking care of [+-] on previous line
    ( $offset / 60 ) % 60, 0
  );
}

=item __tz_diff

  my ($d, $h, $m, $s) = __tz_diff( '+01:00:00', '-07:00:00' );

Calculates the days, hours, minutes and seconds of difference between two specified timezones
in the format C<[+-]HH:MM:SS>. Returns an array containing the difference in days, hours,
minutes and seconds.

=cut

sub __tz_diff {
  my ( $tza, $tzb ) = @_;
  my @tza = split( /:/, $tza );
  my $da = DateTime::Duration->new(
    hours   => $tza[0],
    minutes => $tza[1],
    seconds => $tza[2],
  );
  my @tzb = split( /:/, $tzb );
  my $diff = $da->subtract(
    hours   => $tzb[0],
    minutes => $tzb[1],
    seconds => $tzb[2],
  );
  return ( $diff->days, $diff->hours, $diff->minutes, $diff->seconds );
}

=item __t_diff

  my ($d, $h, $m, $s) = __t_diff( '2009-12-25 00:00:00', '2009-12-25 04:30:02' );

Calculates the days, hours, minutes and seconds of difference between two specified date/time
stamps in the format C<YYYY-MM-DD HH:MM:SS>. Returns an array containing the difference in
days, hours, minutes and seconds.

=cut

sub __t_diff {
  my ( $ta, $tb ) = @_;
  ### Format: YYYY-MM-DD HH:MM:SS
  my $r_datetime = qr/
    ^                   # string begins
    (?<year>\d{4})      # four digits for the year
    \-                  # literal dash
    (?<month>\d{2})     # two digits for the month
    \-                  # literal dash
    (?<day>\d{2})       # two digits for the day
    \s                  # literal space
    (?<hour>\d{2})      # two digits for the hours
    \:                  # literal colon
    (?<minute>\d{2})    # two digits for the minutes
    \:                  # literal colon
    (?<second>\d{2})    # two digits for the seconds
    $
  /x;
  die "Date/Time $ta doesn't match format\n" unless ( $ta =~ $r_datetime );
  my %ta = map { $_, $+{$_} } qw/year month day hour minute second/;
  die "Date/Time $tb doesn't match format\n" unless ( $tb =~ $r_datetime );
  my %tb   = map { $_, $+{$_} } qw/year month day hour minute second/;
  my $dta  = DateTime->new(%ta);
  my $dtb  = DateTime->new(%tb);
  my $diff = $dta->subtract_datetime($dtb);
  return ( $diff->days, $diff->hours, $diff->minutes, $diff->seconds );
}

=item __query_or

  __query_or($q,'name','default',qr/^\d+$/);

Shortcut sub, which returns the CGI query parameter C<name> if specified and if it matches
the quoted regexp, otherwise it returns the C<default> given.

=cut

sub __query_or {
  my $q       = shift;
  my $name    = shift;
  my $default = shift;
  my $regtest = shift;
  my $_data   = $q->param($name);
  return $default unless defined $_data;
  return $default unless $_data =~ $regtest;
  return $_data;
}

=back

=head1 METHODS

=over 8

=item showerror

  showerror( $q, 'error XYZ happened' )

Shortcut sub to return an error page in case an error occurs. The error message passed as
parameter is part of the error page. Returns the full html page to be displayed.

=cut

sub showerror {
  my $q             = shift;
  my $error_message = shift;
  my $output        = '';
  $output .= $q->start_html( -title => 'MySQL Server Status - Error' );
  $output .= $q->h1('An error occured');
  $output .= '<p>' . $error_message . "</p>\n";
  $output .= $q->end_html();
  return $output;
}

=item mysql_timeinfo

  eval { my @t = mysql_timeinfo([ 'dbi:...', 'username', 'password', ... ]) }

Connects to the specified MySQL server (or indeed any DBI connection) using the specified
connection parameters (arrayref). Queries the server for its UTC timestamp, a date/time
stamp, and its offset from UTC. Returns an array comprising of the server's time (seconds
since Epoch), the server's date/time, and the server's timezone offset.

=cut

sub mysql_timeinfo {
  my $dbi_conn_params = shift;
  my $dbh             = DBI->connect(@$dbi_conn_params);
  die "Problems connecting to the database\n" unless defined $dbh;
  my $r = $dbh->selectall_arrayref(
    'SELECT UNIX_TIMESTAMP(), TIMESTAMP(NOW()), TIMEDIFF(NOW(), UTC_TIMESTAMP());' );
  die "Problems capturing date/time from the database\n" unless @$r;
  my $mysql_time     = $r->[0]->[0];
  my $mysql_datetime = $r->[0]->[1];
  my $mysql_timezone = $r->[0]->[2];
  return ( $mysql_time, $mysql_datetime, $mysql_timezone );
}

=back

=head1 CGI Parameters

The following parameters may be passed to the CGI script (either from a GET/POST query or
from the command line via C<name=value>) and can be used to alter the defaults

=over 8

=item server

specifies the server IP address, default 127.0.0.1

=item port

specifies the MySQL server port, default 3306

=item database

specifies which database to connect to, if at all; default C<''>

=item username

the user name to be used for the connection, default C<root>

=item password

the password to be used for the connection, default C<r00t>

=back

=cut

### Get query parameters, set needed details based on either parameters or defaults
### A regexp can be used to decide whether an argument can be considered sane/for use
### simplicistic regexes below
my $q        = CGI->new;
my $server   = __query_or( $q, 'server', '127.0.0.1', qr/^\d+\.\d+\.\d+\.\d+$/ );
my $port     = __query_or( $q, 'port', '3306', qr/^\d+$/ );
my $database = __query_or( $q, 'database', '', qr/^\w*$/ );
my $username = __query_or( $q, 'username', 'root', qr/^[\w\d\_\-]*$/ );
my $password = __query_or( $q, 'password', 'r00t', qr/^[\w\d]*$/ );

### Gather local time, datetime and timezone info
my $here_time = scalar time;
my $here_datetime = strftime( '%Y-%m-%d %H:%M:%S', localtime $here_time );    # same format as mysql
my ( $mysql_time, $mysql_datetime, $mysql_timezone );
my $here_timezone;
my ( $td_days, $td_hours, $td_minutes, $td_seconds );

### mysql_timeinfo, __offset and __t_diff may die
eval {
  ( $mysql_time, $mysql_datetime, $mysql_timezone ) =
    mysql_timeinfo( [ "DBI:mysql:$database:$server:$port", $username, $password ] );
  $here_timezone = __offset(time);    # may die if TZ info isn't right
  ( $td_days, $td_hours, $td_minutes, $td_seconds ) = __t_diff( $here_datetime, $mysql_datetime );
};
### Display error page in case the eval died
if ($@) {
  print $q->header();
  print showerror( $q, $@ );
  exit;
}

### "fix" the mysql timezone returned to be in same format as local
$mysql_timezone = '+' . $mysql_timezone if ( $mysql_timezone !~ /^\-/ );

my ( $tzd_days, $tzd_hours, $tzd_minutes, $tzd_seconds ) =
  __tz_diff( $here_timezone, $mysql_timezone );

### Output the summary page
print $q->header( -charset => 'utf-8' );
my $output = '';
$output .= $q->start_html('MySQL Server time statistics');
$output .= $q->h1(
  "Time statistics for $server" . ( $port ? ':' . $port : '' ) . ' (user: ' . $username . ')' );
$output .= qq{\n};
$output .= qq{<p>MySQL server unix timestamp: $mysql_time</p>\n};
$output .= qq{<p>Local server unix timestamp: $here_time</p>\n};
if ( $mysql_time > $here_time ) {
  $output .= qq{<p>MySQL is running fast by } . ( $mysql_time - $here_time ) . qq{ seconds</p>\n};
} elsif ( $mysql_time == $here_time ) {
  $output .= qq{<p>Both servers are running with the same timestamp</p>\n};
} else {
  $output .= qq{<p>MySQL is running slow by } . ( $here_time - $mysql_time ) . qq{ seconds</p>\n};
}
$output .= qq{<hr />\n};
$output .= qq{<p>MySQL date/time is $mysql_datetime, TZ $mysql_timezone</p>\n};
$output .= qq{<p>Local date/time is $here_datetime, TZ $here_timezone</p>\n};
$output .= qq{<hr />\n};
$output .= qq{<p>Timezone difference: };
$output .= qq{$tzd_days days $tzd_hours hours $tzd_minutes minutes $tzd_seconds seconds</p>};
$output .= qq{<p>Overall difference: };
$output .= qq{$td_days days $td_hours hours $td_minutes minutes $td_seconds seconds</p>};
print $output;
print $q->end_html();

=head1 DIGRESSIONS

When the environment variable C<$ENV{'TZ'}> is defined, unix tools usually use it to override
the system's specified timezone (/etc/localtime link):

  $ TZ=UTC date; TZ=America/New_York date
  Sat Dec 12 13:51:26 UTC 2009
  Sat Dec 12 08:51:26 EST 2009

Perl's C<POSIX> module gives C<strftime>, which similarly uses C<$ENV{'TZ'}>:

  $ TZ=UTC perl -MPOSIX -E'say strftime("%Z",localtime time)'
  UTC
  $ TZ=Europe/Rome perl -MPOSIX -E'say strftime("%Z",localtime time)'
  CET
  $ TZ=Asia/Calcutta perl -MPOSIX -E'say strftime("%Z",localtime time)'
  IST

The C<strftime> function is system dependant and may - or may not - accept a C<%z> parameter
which specifies the number of hours/minutes the timezone is offset from UTC.

C<DateTime::TimeZone> contains a number of modules which help in identifying the offset of a
timezone from UTC regardless of the system. Its C<offset_for_datetime> function correctly returns
the number of seconds a timezone is offset from UTC:

  $ export TZ=UTC;
  $ perl -MDateTime -MPOSIX -MDateTime::TimeZone -E'$n=strftime("%Z",localtime time);
    $d=DateTime::TimeZone->new(name=>$ENV{"TZ"}//$n);$t=DateTime->from_epoch(epoch=>time);
    say $d->offset_for_datetime($t)'
  0
  $ TZ=CET !!; TZ=Asia/Calcutta !!;
  3600
  19800

Certain TZ names aren't recognised (i.e. IST isn't but Asia/Calcutta is).

Testing connection to other MySQL server can also be done via the CLI by specifying query keys
and values after the CGI's name. This and the environment variable help testing.

  ~$ perl mysqltime.cgi username=UUU password=PPP
  ~$ TZ=America/New_York perl mysqltime.cgi username=UUU password=PPP
  ~$ sudo /etc/init.d/mysql stop; ssh -f okram@server.mud.it -L3306:127.0.0.1:3306 sleep 10 &
  ~$ TZ=America/New_York perl mysqltime.cgi username=AAA password=BBB

=cut