#!/usr/bin/perl
use strict;                       
use warnings;                     
use English qw( -no_match_vars ); 
use Getopt::Long;                 
use Data::Dumper;                 

our $VERSION = q{1.0};

$ENV{ 'PATH' } = '~/bin:' . $ENV{ 'PATH' };
my $DEBUG = $ENV{ 'DEBUG' } || 0;

#
# The program options, for command line processing
#

my %parse_options = (
    output_format   => {
             value => 'plain',
             parse => 'f|format=s',
             so    => 1,
             help  => [ 
                         'The output format. {plain|perl} (Default: plain)'
                      ],
        },
    mysql_user      => {
             value =>  undef,
             parse =>  'u|user=s',
             so    =>  2,
             help  => [ 
                         'The user name used with mysql client. (Default: none)' 
                      ],
        },
    mysql_password  => {
             value =>  undef,
             parse =>  'p|password=s',
             so    =>  3,
             help  => [ 
                         'The password used with mysql client. (Default: none)' 
                      ],
        },
    mysql_client    => {
             value =>  'mysql',
             parse =>  'm|mysql=s',
             so    =>  4,
             help  => [ 
                         'The mysql client. You may add options after the file name (default: "mysql")' 
                      ],
        },
    print_pstree    => {
             value =>  0,
             parse =>  'pstree',
             so    =>  5,
             help  => [ 
                         'Print a Process tree after the normal output. (Default: No)' 
                      ],
        },
    help      => {
             value =>  0,
             parse =>  'help',
             so    =>  6,
             help  => [ 
                         'Display this help' 
                      ],
        },
);

my %options = map { $_ , $parse_options{$_}{'value'}}  keys %parse_options;

GetOptions (
    map { $parse_options{ $_ }{ 'parse' }, \$options{ $_ } }        
        grep { $parse_options{ $_ }{ 'parse' }}  
        keys %parse_options 
) or get_help( q{!} );


get_help() if $options{'help'};

#
# Check if we are running under Linux.
# This method of collecting performance data does not
# work under other operating systems
#
unless ($OSNAME =~ /linux/i) {
    die "This program can only work with a GNU/Linux OS\n";
}

# 
# The client used to connect to the database server.
# You can add appropriate username and password with
# the options -u and -p, unless you have a .my.cnf 
# file in your home directory
#
my $MYSQL_CLIENT = sprintf "%s %s %s",
        $options{ 'mysql_client' }, 
        $options{ 'mysql_user' } ? " -u $options{ 'mysql_user' } " : q{},
        $options{ 'mysql_password' } ? " -p$options{ 'mysql_password' } " : q{};

#
# Get the hostname, so your information will be tagged
# to the appropriate host, if you collect this data from
# several servers.
#
my $hostname = get_from_shell(q{ hostname });

#
# Check if mysqld is running
#
get_from_shell(q{ pgrep mysqld }, 1)
    or die "mysqld is not running\n";

# 
# Get the PID file name
#
my $pid_info = get_from_shell( 
        qq($MYSQL_CLIENT -N -e 'show variables like "pid_file"') );

$pid_info or die "unable to get mysqld pid file\n";

my ($pid_file) =  $pid_info =~ m/ 
            ^          # start of string
            \s*        # blanks (if any)
            \w+        # skip the first word
            \s*        # ignore any spaces
            (\S+)      # get a chunk of non-blanks (the file name)
            /x;

# 
# Get mysqld PID
#
my ($mysqld_pid) =  file_slurp( $pid_file );

unless ($mysqld_pid  
        and ( $mysqld_pid =~ m/
                ^     # start of string
                \d+   # all numeric
                $     # end of string
                /x ) ) 
{
    die "could not get a valid PID\n";
}

my $statinfo = get_pid_stats($mysqld_pid);

# 
# Get the user (ID and name) under which mysqld is running
#
my $UID =  $statinfo->{ 'Uid' }; 
my $USER = getpwuid( $UID );

# 
# Recursively search for mysqld_safe PID.
# This loop stops when either a process named mysqlmanager, or mysqld_safe, 
# or safe_mysqld is found (MySQL 3.23 uses a different name) 
# or a parent with PID 1 is found (this should account for a starting 
# script with a non-standard name)
# You may get you an incorrect result if you started mysqld manually
# from the command line.
#
while ( !(
          ($statinfo->{ 'PPid' } == 1)        # parent is /sbin/init
          or ( $statinfo->{ 'Name' } =~ /
                    ^               # start of string
                    (?:             # name is one of the following
                    safe_mysqld     # ... the standard name
                    | mysqld_safe   # ... or the old name
                    | mysqlmanager  # ... or the new manager
                    )               # end of group
                    $               # end of string
                    /x) )) 
{
    $statinfo = get_pid_stats($statinfo->{ 'PPid' });
}

my $mysqldsafe_pid = $statinfo->{ 'Pid' };

my %INFO = (
        hostname    => $hostname,
        mysqld_pid  => $mysqld_pid,
        pid_file    => $pid_file,
        user        => { name => $USER, UID => $UID },
        mysqld_safe => $mysqldsafe_pid,
);

#
# Get information about CPU and memory usage
# for the mysqld process
#
my $process_list = get_from_shell ( "ps -o pcpu,pmem,vsz,rss,dsiz $mysqld_pid" );
 
#
# Get the CPU load for all the processes under mysqld_safe
# and calculate the average
#
my $pstree = `pstree -p $mysqldsafe_pid`;

my $total_cpu_load = 0;
my $active_pid_num = 0;

my @pids = $pstree =~ m/\( (\d+) \)/xg;
my $pid_num = @pids;
my $plist = get_from_shell( "ps -o pcpu @pids", 1); 

# 
# Get the load for each PID
#
while ( $plist =~ /^\s* (\d+\.\d+)/gmx) {
    $total_cpu_load += $1;
    $active_pid_num++; 
}        

#
# calculate the average, avoiding any division by zero traps
#
my $avg_cpu_load = $total_cpu_load ? $total_cpu_load / $active_pid_num : 0 ;

#
# Extract process details
#
if ( $process_list =~ m/
        \s* (\d+\.\d+) # percentage cpu  
        \s+ (\d+\.\d+) # percentage memory
        \s+ (\d+)      # virtual memory size
        \s+ (\d+)      # resident set size
        \s+ (\d+)      # data size
        /x)      
{
    $INFO{ 'mysql_load' } = {
        avg_perc_cpu    => $avg_cpu_load,
        perc_memory     => $2,
        vmem_size       => $3,
        res_set_size    => $4,
        data_size       => $5,
        pids            => $pid_num,
        active_pids     => $active_pid_num,
    };
}

# 
# Get the global server load info
#
my ($server_load) = file_slurp( '/proc/loadavg' );

if ( $server_load =~ m/
        \s* (\d+\.\d+) # cpu load average last  5 minutes
        \s+ (\d+\.\d+) # cpu load average last 10 minutes 
        \s+ (\d+\.\d+) # cpu load average last 15 minutes 
        /x ) 
{
    $INFO{ 'server_load' } = {
        cpu5    => $1,
        cpu10   => $2,
        cpu15   => $3,
    };
}

# 
# Get the number of open files for the mysqld process.
# Notice that you won't be able to access this list as 
# a normal user if mysqld_safe was launched by root.
#
my @file_descriptors = glob "/proc/$mysqld_pid/fd/*";

$INFO{ 'open_files' } = scalar @file_descriptors;

if ($options{ 'output_format' } eq 'perl') {
    perl_output( \%INFO );
}
elsif ($options{ 'output_format' } eq 'plain') {
    plain_output(\%INFO);
}
else {
    die "unrecognized output format ($options{ 'output_format' })\n";
}

if ($options{ 'print_pstree' }) {
    print "\n", $pstree;
}

#
# subs follow
#

#
# the plain text report
#
sub plain_output {
    my ($info) = @_;
    my $template = <<'END_PLAIN';
    hostname         : %10s
    mysql_pid        : %10d 
    pid_file         : %s
    mysqld_safe      : %10d
    open_files       : %10d

    user 
    ----
        name         : %10s
        UID          : %10d           

    mysql_load
    ----------
        avg_perc_cpu : %10.2f
        perc_memory  : %10.2f
        vmem_size    : %10d
        res_set_size : %10d
        data_size    : %10d
        pids         : %10d
        active_pids  : %10d

    server_load
    -----------
        cpu5         : %10.2f
        cpu10        : %10.2f
        cpu15        : %10.2f
END_PLAIN

    print credits(), "\n";
    printf $template,
        @$info{qw( hostname mysqld_pid pid_file mysqld_safe open_files ) },
        $info->{ 'user' }{ 'name' }, 
        $info->{ 'user' }{ 'UID' },
        $info->{ 'mysql_load' }{ 'avg_perc_cpu' }, 
        $info->{ 'mysql_load' }{ 'perc_memory' }, 
        $info->{ 'mysql_load' }{ 'vmem_size' }, 
        $info->{ 'mysql_load' }{ 'res_set_size' }, 
        $info->{ 'mysql_load' }{ 'data_size' }, 
        $info->{ 'mysql_load' }{ 'pids' }, 
        $info->{ 'mysql_load' }{ 'active_pids' }, 
        $info->{ 'server_load' }{ 'cpu5' },
        $info->{ 'server_load' }{ 'cpu10' },
        $info->{ 'server_load' }{ 'cpu15' };
}

#
# the report in Perl format.
# Useful for loading it from another program, or to
# pipe it (see help for examples)
#
sub perl_output {
    my ($info) = @_;
    print Data::Dumper->Dump( [ $info ], ['INFO'] );
}

#
# reads the file /proc/PID/status
# and returns a hash with its values
#

sub get_pid_stats {
    my ($pid) = @_;

    my %stat_info;
    my @pid_status = file_slurp ( "/proc/$pid/status" );
    for my $line (@pid_status) {
        my ($key, $value) = $line =~ m/
                    ^       # start of string
                    (\w+)   # first word
                    :       # a colon
                    \s+     # skip any blanks
                    (\S+)   # the first chunk of non-blank characters
                    /x ;
        next unless $key;
        $stat_info{$key} = $value;
    }
    return \%stat_info;
}

#
# reads a file and returns an array
# (one element for each line)
#
sub file_slurp {
    my ($filename) = @_;
    print "reading $filename\n" if $DEBUG;
    $filename 
        or die "can't open a empty filename\n";
    open my $FD, q{<}, $filename
        or die "can't open $filename ($ERRNO)\n";
    my @contents = <$FD>;
    chomp @contents;
    close $FD;
    return @contents;
}

#
# executes a shell command
# and returns its output
#
sub get_from_shell {
    my ($cmd, $ignore_error) = @_;
    my $result;
    print "executing $cmd\n" if $DEBUG >= 1;
    $result = qx{$cmd} ;
    if ( $CHILD_ERROR and ! $ignore_error ) {
        warn "'$cmd' returned error $CHILD_ERROR.\n";
    }
    chomp $result;
    print "$result\n" if $DEBUG >= 2;
    return $result;
}

# 
# Help for this program
#
sub get_help {
    my ($msg) = @_;

    my $HELP_MSG = q{};
    for my $op ( 
                sort { $parse_options{$a}{ 'so' } <=> $parse_options{$b}{ 'so' } } 
                grep { $parse_options{$_}{ 'parse' }}  keys %parse_options ) 
    {
        my $param =  $parse_options{$op}{ 'parse' };
        my $param_str = q{    };
        my ($short, $long ) = $param =~ / (?: (\w) \| )? (\S+) /x;
        if ($short) {
            $param_str .= q{-} . $short . q{ };
        } 
        $long =~ s/ = s \@? / = name/x;
        $long =~ s/ = i / = number/x;
        $param_str .= q{--} . $long;
        $param_str .= (q{ } x (40 - length($param_str)) );
        my $text_items = $parse_options{$op}{ 'help' };
        for my $titem (@{$text_items}) {
            $HELP_MSG .= $param_str . $titem . "\n";
            $param_str = q{ } x 40;
        }
        if (@{$text_items} > 1) {
            $HELP_MSG .= "\n";
        }
        # $HELP_MSG .= "\n";
    }

    if ($msg) {
        warn "[***] $msg\n\n";
    }
    print credits(),"\n",
        "syntax: $PROGRAM_NAME [options] \n", 
        $HELP_MSG;

    print "\n    You may get output in other formats, by piping the 'perl' output\n",
          "    for example: \n    ",
          $PROGRAM_NAME, 
          q{ -f perl | perl -MYAML -0ne 'eval $_; print Dump $INFO'},
          "\n",
          "    or: \n    ",
          $PROGRAM_NAME, 
          q{ -f perl | perl -MXML::Simple -0ne 'eval $_; print XMLout $INFO, AttrIndent=>1'},
          "\n\n";
    if ($msg) {
        exit 1;
    }
    else {
        exit 0;
    }
}

#
# Who made it
#
sub credits {
    my $CREDITS = 
          qq(    The MySQL Resource Locator,  version $VERSION\n) 
        . qq(    (C) 2006 Giuseppe Maxia, Stardata s.r.l.\n);
    return $CREDITS;
}