#!/usr/bin/perl -wT

use strict;
use warnings;

our $VERSION = '0.08';

$ENV{PATH} = '/bin:/usr/bin'; # untaint

BEGIN {

    unless (eval { require Beekeeper }) {
        # Modules not installed yet
        unshift @INC, ($ENV{'PERL5LIB'} =~ m/([^:]+)/g);
    }
}

use Beekeeper::Service::Supervisor;
use Term::ReadKey;
use Getopt::Long;

ReadMode "cbreak";
END { ReadMode "restore" }

my ($opt_host, $opt_pool, $opt_class, $opt_list, $opt_batch, $opt_help);

GetOptions(
    "host=s"    => \$opt_host,    # --host
    "pool=s"    => \$opt_pool,    # --pool
    "class=s"   => \$opt_class,   # --class
    "list"      => \$opt_list,    # --list
    "batch"     => \$opt_batch,   # --batch
    "help"      => \$opt_help,    # --help    
) or exit;

my $Help = "
Usage: bkpr-top [OPTIONS]
Display real-time performance metrics of running workers.

  -h, --host  str  display status only of specified host
  -p, --pool  str  display status only of specified pool
  -c, --class str  display status only of specified worker class
  -l, --list       display status of every individual worker
  -b, --batch      display current status and exit immediately
  -h, --help       display this help and exit

Filters --host, --pool and --class can be combined.

The metrics displayed are:

   nps:   number of received notifications per second
   cps:   number of processed calls per second
   err:   number of errors per second
   mem:   resident non shared memory size in KiB
   cpu:   percentage of CPU load
   load:  percentage of busy time

Change sorting pressing (N)otifications, (C)alls, (M)emory, cp(U) or (L)oad.

";

if ($opt_help) {
    print $Help;
    exit;
}

if ($opt_list) {

    my $printed_lines = 0;
    my $sort_field = 'pid';
    my $order_desc = 1;
    my $scr_size = '';

    my %sort_fields = (
        'S' => 'class',
        'P' => 'pool',
        'H' => 'host',
        'I' => 'pid',
        'M' => 'mem',
        'N' => 'nps',
        'C' => 'cps',
        'E' => 'err',
        'U' => 'cpu',
        'L' => 'load',
    );

    while (1) {

        my $workers = Beekeeper::Service::Supervisor->get_workers_status(
            host  => $opt_host,
            pool  => $opt_pool,
            class => $opt_class,
        );

        my ($columns) = `tput cols`  =~ m/(\d+)/;
        my ($lines)   = `tput lines` =~ m/(\d+)/;

        # Clear the screen when dimensions change
        print "\033[2J" if ($scr_size ne "$columns-$lines" && !$opt_batch);
        $scr_size = "$columns-$lines";

        my $w = $columns - 66;
        $w = 0 if $w < 0;

        # Echo title
        print "\033[0;0H" unless $opt_batch;  # jump to 0,0
        print "\033[7m";                      # reverse
        printf("%-${w}.${w}s %-8s %-8s %5s %8s %5s %5s %5s %5s %7s \n",
               'class','pool','host','pid','KiB','nps','cps','err','cpu','load');
        print "\033[0m";  # back to normal

        # Sort
        my @workers = ($sort_field =~ m/class|pool|host|queue/) ? 
            sort { ($b->{$sort_field} || '') cmp ($a->{$sort_field} || '') || $a->{pid} <=> $b->{pid} } @$workers :
            sort { ($a->{$sort_field} || 0 ) <=> ($b->{$sort_field} || 0 ) || $a->{pid} <=> $b->{pid} } @$workers ;

        @workers = reverse @workers if ($order_desc);

        # Limit displayed lines in order to fit screen
        splice( @workers, $lines - 2 );

        foreach my $worker (@workers) {
            $worker->{class} =~ s/::Worker$//;
            printf("%-${w}.${w}s %-8s %-8s %5s %8s %5s %5s %5s %5s %5s %% \n",
                $worker->{class},
                $worker->{pool},
                $worker->{host},
                $worker->{pid},
                $worker->{mem} || '-',
                sprintf("%.0f", $worker->{nps}  + .5) || '0',
                sprintf("%.0f", $worker->{cps}  + .5) || '0',
                sprintf("%.0f", $worker->{err}  + .5) || '0',
                sprintf("%.0f", $worker->{cpu}  + .5) || '0',
                sprintf("%.0f", $worker->{load} + .5) || '0',
            );
        }

        # Clear old lines at bottom screen
        print " " x $columns . "\n" for (@workers..$printed_lines-1);
        $printed_lines = scalar @workers;

        last if $opt_batch;

        sleep 1;

        my $key = uc( ReadKey(-1) || '');
        last if ($key eq 'Q');
        if ($sort_fields{$key}) {
            $order_desc = ($sort_field eq $sort_fields{$key}) ? !$order_desc : 1;
            $sort_field = $sort_fields{$key};
        }
    }
}
else {

    my $printed_lines = 0;
    my $sort_field = 'class';
    my $order_desc = 1;
    my $scr_size = '';

    my %sort_fields = (
        'S' => 'class',
        'W' => 'count',
        'M' => 'mem',
        'N' => 'nps',
        'C' => 'cps',
        'E' => 'err',
        'U' => 'cpu',
        'L' => 'load',
    );

    while (1) {

        my $services = Beekeeper::Service::Supervisor->get_services_status(
            host  => $opt_host,
            pool  => $opt_pool,
            class => $opt_class,
        );

        foreach my $svc (keys %$services) {
            $services->{$svc}->{class} = $svc;
        }

        my @services = values %$services;

        my ($columns) = `tput cols`  =~ m/(\d+)/;
        my ($lines)   = `tput lines` =~ m/(\d+)/;

        # Clear the screen when dimensions change
        print "\033[2J" if ($scr_size ne "$columns-$lines" && !$opt_batch);
        $scr_size = "$columns-$lines";

        my $w = $columns - 57;
        $w = 0 if $w < 0;

        # Echo title
        print "\033[0;0H" unless $opt_batch;  # jump to 0,0
        print "\033[7m";                      # reverse
        printf("%-${w}.${w}s %5s %8s %8s %8s %8s %5s %7s \n",
               'class','count','MiB','nps','cps','err','cpu','load');
        print "\033[0m";  # back to normal

        # Sort
        @services = ($sort_field =~ m/class/) ? 
            sort { ($b->{$sort_field} || '') cmp ($a->{$sort_field} || '') } @services :
            sort { ($a->{$sort_field} || 0 ) <=> ($b->{$sort_field} || 0 ) } @services ;

        @services = reverse @services if ($order_desc);

        # Limit displayed lines in order to fit screen
        splice( @services, $lines - 2 );

        foreach my $svc (@services) {
            $svc->{class} =~ s/::Worker$//;
            printf("%-${w}.${w}s %5d %8.1f %8.1f %8.1f %8.1f %5.0f %5.0f %% \n", 
                $svc->{class},
                $svc->{count},
                $svc->{mem} / 1000,
                $svc->{nps},
                $svc->{cps},
                $svc->{err},
                $svc->{cpu},
                $svc->{load},
            );
        }

        # Clear old lines at bottom screen
        print " " x $columns, "\n" for (@services..$printed_lines-1);
        $printed_lines = scalar @services;

        last if $opt_batch;

        sleep 1;

        my $key = uc( ReadKey(-1) || '');
        last if ($key eq 'Q');
        if ($sort_fields{$key}) {
            $order_desc = ($sort_field eq $sort_fields{$key}) ? !$order_desc : 1;
            $sort_field = $sort_fields{$key};
        }
    }
}


__END__

=pod

=encoding utf8

=head1 NAME

bkpr-top - Display real-time performance metrics of running workers

=head1 VERSION

Version 0.08

=head1 SYNOPSIS

  Usage: bkpr-top [OPTIONS]
  
  Display real-time performance metrics of running workers.
  
    -h, --host  str  display status only of specified host
    -p, --pool  str  display status only of specified pool
    -c, --class str  display status only of specified worker class
    -l, --list       display status of every individual worker
    -b, --batch      display current status and exit immediately
    -h, --help       display this help and exit
  
  Filters --host, --pool and --class can be combined.
  
  The metrics displayed are:
  
     nps:   number of received notifications per second
     cps:   number of processed calls per second
     err:   number of errors per second
     mem:   resident memory size in KiB
     cpu:   percentage of CPU load
     load:  percentage of busy time
  
  Change sorting field pressing (N)otifications, (C)alls, (M)emory, cp(U) or (L)oad.

=head1 DESCRIPTION

Display real-time performance metrics of running workers in a C<top> fashion.

Sorting order can be changed pressing keys N, C, M, U and L.
Pressing Q quits the program.

=head3 Displayed metrics

=over

=item nps

Number of received notifications per second.

=item cps

Number of processed calls per second.

=item err

Number of errors per second generated while handling calls or notifications.

=item mem

Resident non shared memory size in KiB. This is roughly equivalent to the value
of C<RES> minus C<SHR> displayed by C<top>.

For example, supposing that there are 2 GiB of memory available, a service that 
shows a C<mem> usage of 1024 is using half of the memory resources.

=item cpu

Percentage of CPU load (100 indicates a full utilization of one core thread).

For example, supposing that there are 4 core threads available, a service that
shows a C<cpu> load of 200 is using half of the CPU resources.

=item load

Percentage of busy time (100% indicates that there are no idle workers).

Note that workers can have a high load with very little CPU usage when being
blocked by synchronous operations (like slow SQL queries).

For example, supposing that there are 10 workers running, a service that shows a 
C<load> of 50% is working at half capacity. Spawning 10 additional workers will 
lower the load to 25%.

Due to inaccuracies of measurement the actual maximum may be slightly below 100%.

=back

Unless the option C<--host> is passed the values shown are the aggregate of all
workers, even if these are on different hosts.

=head1 SEE ALSO

L<Beekeeper::Service::Supervisor>.

=head1 AUTHOR

José Micó, C<jose.mico@gmail.com>

=head1 COPYRIGHT AND LICENSE

Copyright 2015-2021 José Micó.

This is free software; you can redistribute it and/or modify it under the same 
terms as the Perl 5 programming language itself.

This software is distributed in the hope that it will be useful, but it is 
provided “as is” and without any express or implied warranties. For details, 
see the full text of the license in the file LICENSE.

=cut
