#!/usr/bin/perl

=pod

=head1 NAME

pgtop - display PostgreSQL performance info like `top'

=cut

## most of the POD is at the bottom of the file

BEGIN {
    $| = 1;
    $0 = 'pgtop';
}

use 5.014;
use strict;
use open qw( :encoding(UTF-8) :std );
use utf8;
use warnings qw( FATAL utf8 );
use autodie;

use Data::Dumper;
use DBI;
use Getopt::Long;
use JSON;
use LWP::UserAgent;
use Socket;
use Term::ReadKey;

our $VERSION = '0.11';
my $debug = 0;

my $START_TIME = time();
my $is_windows = $^O eq 'MSWin32';

## Test for color support.

eval { require Term::ANSIColor; };
my $HAS_COLOR = $@ ? 0 : 1;
$HAS_COLOR = 0 if $is_windows;

## Test of Time::HiRes support

eval { require Time::HiRes };
my $HAS_TIME = $@ ? 0 : 1;

## Try to lower our priority (which, who, pri)

setpriority(0, 0, 10) unless $is_windows;

## Prototypes

sub Clear();
sub GetData();
sub GetQPS();
sub FullQueryInfo($);
sub Explain($);
sub PrintTable(@);
sub PrintHelp();
sub Sum(@);
sub commify($);
sub make_short($);
sub Hashes($);
sub Execute($);
sub StringOrRegex($);
sub GetInnoDBStatus();
sub GetCmdSummary();
sub cmd_s;
sub cmd_q;

## Default Config Values

my %config = (
    delay          => 5,
    host           => 'localhost',
    db             => 'test',
    user           => 'postgres',
    pass           => '',
    port           => 5432,
    socket         => '',
    batchmode      => 0,
    header         => 1,
    color          => 1,
    idle           => 1,
    prompt         => 0,
    mode           => 'top',
    sort           => 0,         # default or reverse sort ("s")
    filter_user    => qr/.?/,
    filter_db      => qr/.?/,
    filter_host    => qr/.?/,
    long_nums      => 0,
    slack_webhook  => '',
    slow_threshold => 60,
);

my %qcache = ();           # The query cache--used for full query info support.
my %ucache = ();           # The user cache--used for full killing by user
my %dbcache = ();          # The db cache.  This should be merged at some point.
my %runtime = ();          # Stores the query runtime
my %historic_runtime = (); # Used to detect queries crossing the slow thresholds

my (%STATUS, %OLD_STATUS); # header stuff.

my $CLEAR = $is_windows ? '': `clear`;

## Term::ReadKey values

my $RM_RESET    = 0;
my $RM_PASSWORD = 2;
my $RM_NOBLKRD  = 3; # using 4 traps Ctrl-C

## Command-line args.

Getopt::Long::Configure('no_ignore_case', 'bundling');

GetOptions(
    "config=s"            => \(my $config = "$ENV{HOME}/.pgtop"),
    "color!"              => \$config{color},
    "user|u=s"            => \$config{user},
    "pass|password|p=s"   => \$config{pass},
    "database|db|d=s"     => \$config{db},
    "host|h=s"            => \$config{host},
    "port|P=i"            => \$config{port},
    "socket|S=s"          => \$config{socket},
    "delay|s=i"           => \$config{delay},
    "batch|batchmode|b"   => \$config{batchmode},
    "header!"             => \$config{header},
    "idle|i"              => \$config{idle},
    "resolve|r"           => \$config{resolve},
    "prompt!"             => \$config{prompt},
    "long|!"              => \$config{long_nums},
    "slow_threshold=i"    => \$config{slow_threshold},
    "slack_webhook=s"     => \$config{slack_webhook},
);

## Read the user's config file, if it exists.

if (! -e $config) {
    # Try with our sister utility configuration
    $config = "$ENV{HOME}/.mytop";
}

if (-e $config) {
    if (open my $config_fh, "<", $config) {
        while (readline $config_fh) {
            next if /^\s*$/;  ## skip blanks
            next if /^\s*#/;  ## skip comments

            chomp;

            if (/(\S+)\s*=\s*(\S+)/) {
                $config{lc $1} = $2 if exists $config{lc $1};
            }
        }
        close $config_fh;
    }
}

## User may have put the port with the host.

if ($config{host} =~ s/:(\d+)$//) {
    $config{port} = $1;
}

## User may want to disable color.
if ($HAS_COLOR and not $config{color}) {
    $HAS_COLOR = 0;
}

if ($HAS_COLOR) {
    import Term::ANSIColor ':constants';
}
else {
    *RESET  = sub { };
    *YELLOW = sub { };
    *RED    = sub { };
    *GREEN  = sub { };
    *BLUE   = sub { };
    *WHITE  = sub { };
    *BOLD   = sub { };
}

my $RESET  = RESET()   || '';
my $YELLOW = YELLOW()  || '';
my $RED    = RED()     || '';
my $GREEN  = GREEN()   || '';
my $BLUE   = BLUE()    || '';
my $WHITE  = WHITE()   || '';
my $BOLD   = BOLD()    || '';

## Connect

my $dsn;

## Socket takes precedence.

$dsn ="DBI:Pg:dbname=$config{db};";

=cut
if ($config{socket} and -S $config{socket})
{
    $dsn .= "pg_socket=$config{socket}";
}
else
=cut

{
    $dsn .= "host=$config{host};port=$config{port}";
}

if ($config{prompt}) {
    print "Password: ";
    ReadMode($RM_PASSWORD);
    chomp($config{pass} = <STDIN>);
    ReadMode($RM_RESET);
    print "\n";
}

my $dbh = DBI->connect($dsn, $config{user}, $config{pass},
                       { PrintError => 0 });

if (not ref $dbh)
{
    my $Error = <<EODIE
Cannot connect to PostgreSQL server. Please check the:

  * database you specified "$config{db}" (default is "test")
  * username you specified "$config{user}" (default is "postgres")
  * password you specified "$config{pass}" (default is "")
  * hostname you specified "$config{host}" (default is "localhost")
  * port you specified "$config{port}" (default is 5432)
  * socket you specified "$config{socket}" (default is "")

The options my be specified on the command-line or in a ~/.pgtop
config file. See the manual (perldoc pgtop) for details.

Here's the exact error from DBI. It might help you debug:

$DBI::errstr

EODIE
;

    die $Error;

}

ReadMode($RM_RESET) unless $config{batchmode};

## Get static data

my($db_version) = Hashes("select version()");
if( ref $db_version eq 'HASH' )
{
    if( $db_version->{version} =~ /PostgreSQL ([\d\.]+)/i )
    {
        $db_version = $1;
    }
}

my $have_query_cache;

my @variables = Hashes("show all");

foreach (@variables)
{
=cut
    if ($_->{Variable_name} eq "version")
    {
        $db_version = $_->{Value};
        next;
    }
=cut
    if ($_->{Variable_name} eq "have_query_cache")
    {
        if ($_->{Value} eq 'YES')
        {
            $have_query_cache = 1;
        }
        else
        {
            $have_query_cache = 0;
        }
        next;
    }
}

#########################################################################
##
## The main loop
##
#########################################################################

ReadMode($RM_NOBLKRD) unless defined $config{batchmode};

while (1)
{
    my $key;

    if ($config{mode} eq 'qps')
    {
        GetQPS();
        $key = ReadKey(1);

        next unless $key;

        if ($key =~ /t/i)
        {
            $config{mode} = 'top';
        }
        if ($key =~ /q/)
        {
            cmd_q();
        }
        next;
    }
    if ($config{mode} eq 'top')
    {
        GetData();
        last if $config{batchmode};
        ReadMode($RM_NOBLKRD);
        $key = ReadKey($config{delay});
        next unless defined $key;
    }
    elsif ($config{mode} eq 'cmd_summary')
    {
        GetCmdSummary();
        last if $config{batchmode};
        $key = ReadKey($config{delay});
        next unless $key;
    }
    elsif ($config{mode} eq 'innodb_status')
    {
        GetInnoDBStatus();
        last if $config{batchmode};
        $key = ReadKey($config{delay});
        next unless $key;
    }

    ##
    ## keystroke command processing (if we get this far)
    ##

    # t - top

    if ($key =~ /t/i)
    {
        $config{mode} = 'top';
    }

    ## q - quit

    if ($key eq 'q')
    {
        cmd_q();
    }

    if ($key eq 'D')
    {
        say Data::Dumper::Dumper([\%config]);
        ReadKey(0);
    }

    ## m - mode swtich to qps

    if ($key eq 'm')
    {
        $config{mode} = 'qps';
        Clear() unless $config{batchmode};
        print "Queries Per Second [hit q to exit this mode]\n";
        next;
    }

    ## c - mode switch to command summary

    if ($key eq 'c')
    {
        $config{mode} = 'cmd_summary';
        Clear() unless $config{batchmode};
        print "Command Summary [hit q to exit this mode]\n";
        next;
    }

    ## s - seconds of delay

    if ($key eq 's')
    {
        cmd_s();
        next;
    }

    ## u - username based filter

    if ($key eq 'u')
    {
        ReadMode($RM_RESET);
        print RED(), "Which user (blank for all, /.../ for regex): ", RESET();
        $config{filter_user} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## d - database name based filter

    if ($key eq 'd')
    {
        ReadMode($RM_RESET);
        print RED(), "Which database (blank for all, /.../ for regex): ",
        RESET();
        $config{filter_db} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## h - hostname based filter

    if ($key eq 'h')
    {
        ReadMode($RM_RESET);
        print RED(), "Which hostname (blank for all, /.../ for regex): ",
            RESET();
        $config{filter_host} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## F - remove all filters

    if ($key eq 'F')
    {
        $config{filter_host} = qr/.?/;
        $config{filter_db}   = qr/.?/;
        $config{filter_user} = qr/.?/;
        print RED(), "-- display unfiltered --", RESET();
        sleep 1;
        next;
    }

    ## p - pause

    if ($key eq 'p')
    {
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
        next;
    }

    ## i - idle toggle

    if ($key =~ /i/)
    {
        if ($config{idle})
        {
            $config{idle} = 0;
            $config{sort} = 1;
            print RED(), "-- idle (sleeping) processed filtered --", RESET();
            sleep 1;
        }
        else
        {
            $config{idle} = 1;
            $config{sort} = 0;
            print RED(), "-- idle (sleeping) processed unfiltered --", RESET();
            sleep 1;
        }
    }

    ## o - sort order

    if ($key =~ /o/)
    {
        if ($config{sort})
        {
            $config{sort} = 0;
            print RED(), "-- sort order reversed --", RESET();
            sleep 1;
        }
        else
        {
            $config{sort} = 1;
            print RED(), "-- sort order reversed --", RESET();
            sleep 1;
        }
    }

    ## ? - help

    if ($key eq '?')
    {
        Clear();
        PrintHelp();
        ReadKey(0);
        next;
    }

    ## k - kill

    if ($key eq 'k')
    {
        ReadMode($RM_RESET);

        print RED(), "Thread id to kill: ", RESET();
        my $id = ReadLine(0);

        $id =~ s/\s//g;

        if ($id =~ /^\d+$/)
        {
            Execute("SELECT pg_cancel_backend($id)");
        }
        else
        {
            print RED(), "-- invalid thread id --", RESET();
            sleep 1;
        }

        ReadMode($RM_NOBLKRD);
        next;
    }

    ## K - query killer (all queries running longer than X seconds are killed)
    if ($key eq 'K')
    {
        ReadMode($RM_RESET);

        print RED(),
            "Kill ", BOLD(), "ALL", RESET(), RED(),
            " queries longer than? (seconds): ", RESET();

        my $query_ttl = ReadLine(0);
        $query_ttl =~ s{\D}{}gx;

        # Won't allow users to kill queries that have been
        # running for less than this value, for safety.
        #
        # Say it's 2:00 AM and I mistype 0 instead of 30 because I'm tired.
        # All my running queries would be obliterated and I wouldn't like that.

        my $min_safe_ttl = 30;

        if ($query_ttl =~ m{\A \d+ \Z}x && $query_ttl > $min_safe_ttl) {
            $query_ttl = 0 + $query_ttl;
            my $killed = 0;
            for my $pid (keys %runtime) {
                if ($runtime{$pid} > $query_ttl) {
                    # FIXME Execute("SELECT pg_cancel_backend($pid)");
                    print "Query $pid would be killed! (runtime=$runtime{$pid} > $query_ttl)\n";
                    select(undef, undef, undef, 0.1);
                    $killed++;
                }
            }
            if ($killed == 0) {
                print YELLOW(),
                    "-- ",
                    ($killed == 0 ? "no" : $killed),
                    " ",
                    ($killed == 1 ? "query was" : "queries were"),
                    " killed --",
                    RESET();
            }
            sleep 5;
        }
        else {
            print RED(), "-- invalid query ttl --", RESET();
            sleep 1;
        }

        ReadMode($RM_NOBLKRD);
    }

    ## f - full info

    if ($key eq 'f')
    {
        ReadMode($RM_RESET);
        print RED(), "Full query for which thread id: ", RESET();
        my $id = ReadLine(0);
        chomp $id;
        FullQueryInfo($id);
        ReadMode($RM_NOBLKRD);
        print RED(), "-- paused. press any key to resume or (e) to explain --",
        RESET();
        my $key = ReadKey(0);

        if ($key eq 'e')
        {
            Explain($id);
            print RED(), "-- paused. press any key to resume --", RESET();
            ReadKey(0);
        }

        next;
    }

    ## e - explain

    if ($key =~ /e/)
    {
        ReadMode($RM_RESET);
        print RED(), "Explain which query (id): ", RESET();
        my $id = ReadLine(0);
        chomp $id;
        Explain($id);
        ReadMode($RM_NOBLKRD);
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
        next;
    }

    ## r - reset status counters

    if ($key =~ /r/)
    {
        # TODO ??? reset stats?
        Execute("FLUSH STATUS");
        print RED(), "-- counters reset --", RESET();
        sleep 1;
        next;
    }

    ## H - header toggle

    if ($key eq 'H')
    {
        if ($config{header})
        {
            $config{header} = 0;
        }
        else
        {
            $config{header}++;
        }
    }

    ## # - magic debug key

    if ($key eq '#')
    {
        $debug = 1;
    }

}

ReadMode($RM_RESET) unless $config{batchmode};

exit;

#######################################################################

sub Clear()
{
    print $is_windows
        ? "\n" x 90      ## dumb hack for now. Anyone know how to
                         ## clear the screen in dos window on a Win32
                         ## system??
        : "$CLEAR";
}

my $last_time;

sub GetData()
{
    my $now_time;

    %qcache = ();  ## recycle memory
    %dbcache = ();
    %runtime = ();

    ## Get terminal info
    my ($width, $height, $wpx, $hpx, $lines_left);

    if (not $config{batchmode})
    {
        ($width, $height, $wpx, $hpx) = GetTerminalSize();
        $lines_left = $height - 2;
    }
    else
    {
        $height = 999_999;     ## I hope you don't have more than that!
        $lines_left = 999_999;
        $width = 80;
    }

    ##
    ## Header stuff.
    ##
    if ($config{header})
    {
        my @recs = Hashes("show all");

        ## if the server died or we lost connectivity
        if (not @recs)
        {
            ReadMode($RM_RESET);
            exit 1;
        }

        ## get high-res or low-res time
        my ($t_delta);

        if ($HAS_TIME)
        {
            $now_time = Time::HiRes::gettimeofday();
        }
        else
        {
            $now_time = time;
        }

        if ($last_time and $last_time != $now_time)
        {
          $t_delta = $now_time - $last_time;
        }

        %OLD_STATUS = %STATUS;

        foreach my $ref (@recs)
        {
            my $key = $ref->{Variable_name};
            my $val = $ref->{Value};

            $STATUS{$key} = $val;
        }

        ## Compute Key Cache Hit Stats

        $STATUS{Key_read_requests} ||= 1; ## can't divide by zero next

        my $cache_hits_percent = (100-($STATUS{Key_reads}/$STATUS{Key_read_requests}) * 100);
        $cache_hits_percent = sprintf("%2.2f",$cache_hits_percent);

        ## Query Cache info
        ##
        ## mysql> show status like 'qcache%';
        ## +-------------------------+----------+
        ## | Variable_name           | Value    |
        ## +-------------------------+----------+
        ## | Qcache_queries_in_cache | 81       |
        ## | Qcache_inserts          | 4961668  |
        ## | Qcache_hits             | 1374170  |
        ## | Qcache_not_cached       | 5656249  |
        ## | Qcache_free_memory      | 33164800 |
        ## | Qcache_free_blocks      | 2        |
        ## | Qcache_total_blocks     | 168      |
        ## +-------------------------+----------+

        my $query_cache_hits             = 0;
        my $query_cache_hits_per_sec     = 0;
        my $now_query_cache_hits_per_sec = 0;

        if ($have_query_cache)
        {
            $query_cache_hits = $STATUS{Qcache_hits};
            $query_cache_hits_per_sec = $STATUS{Qcache_hits} / $STATUS{Uptime};

            if (defined $last_time and $last_time != $now_time)
            {
                my $q_delta = $STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits};
                $now_query_cache_hits_per_sec = sprintf "%.2f", $q_delta / $t_delta;
            }
        }

        $last_time = $now_time;

        # Get server's activity (Questions)
        GetQuestions(\%STATUS);

        my $time         = $STATUS{Uptime};
        my ($d,$h,$m,$s) = (0, 0, 0, 0);

        $d += int($time / (60*60*24)); $time -= $d * (60*60*24);
        $h += int($time / (60*60));    $time -= $h * (60*60);
        $m += int($time / (60));       $time -= $m * (60);
        $s += int($time);

        my $uptime = sprintf("%d+%02d:%02d:%02d", $d, $h, $m, $s);

        ## Queries per second...

        my $avg_queries_per_sec  = sprintf("%.2f", $STATUS{Questions} / $STATUS{Uptime});
        my $num_queries          = $STATUS{Questions};

        my @t = localtime(time);

        my $current_time = sprintf "[%02d:%02d:%02d]", $t[2], $t[1], $t[0];

        my $host_width = 52;
        my $up_width   = $width - $host_width;

        Clear() unless $config{batchmode};
        print RESET();

        printf "%-${host_width}s%${up_width}s\n",
               "PgSQL on $config{host} ($db_version)",
               "up $uptime $current_time";
        $lines_left--;


        printf " Queries: %-5s  qps: %4.0f Slow: %7s         Se/In/Up/De(%%):    %02.0f/%02.0f/%02.0f/%02.0f \n",
               make_short( $STATUS{Questions} ),  # q total
               $STATUS{Questions} / $STATUS{Uptime},  # qps, average
               make_short( $STATUS{Slow_queries} ),    # slow

               # hmm. a Qcache hit is really a select and should be counted.
               100 * ($STATUS{Com_select} + ($STATUS{Qcache_hits}||0) )    / $STATUS{Questions},
               100 * ($STATUS{Com_insert} +  $STATUS{Com_replace} ) / $STATUS{Questions},
               100 * ($STATUS{Com_update} )  / $STATUS{Questions},
               100 * $STATUS{Com_delete} / $STATUS{Questions};

        $lines_left--;

        if ($t_delta)
        {
          my $q_diff = ( $STATUS{Questions} - $OLD_STATUS{Questions} );
          $q_diff = 1 if $q_diff == 0;
#          print("q_diff: $STATUS{Questions} - $OLD_STATUS{Questions}  / $t_delta = $q_diff\n");

          printf("             qps now: %4.0f Slow qps: %3.1f  Threads: %4.0f (%4.0f/%4.0f) %02.0f/%02.0f/%02.0f/%02.0f \n",
                 ( $STATUS{Questions} - $OLD_STATUS{Questions} ) / $t_delta,
                 ( # slow now (qps)
                  ($STATUS{Slow_queries} ) ?
                  ( $STATUS{Slow_queries} - $OLD_STATUS{Slow_queries} ) / $t_delta :
                  0
                 ),
                 $STATUS{Threads_connected},
                 $STATUS{Threads_running},
                 $STATUS{Threads_cached},

                 (100 * ($STATUS{Com_select} - $OLD_STATUS{Com_select} + 
                         ($STATUS{Qcache_hits}||0) - ($OLD_STATUS{Qcache_hits}||0)
                        ) ) / ($q_diff ),
                 (100 * ($STATUS{Com_insert} - $OLD_STATUS{Com_insert} +
                         $STATUS{Com_replace} - $OLD_STATUS{Com_replace}
                        ) ) / ($q_diff ),
                 (100 * ($STATUS{Com_update} - $OLD_STATUS{Com_update}) ) / ($q_diff ),
                 (100 * ($STATUS{Com_delete} - $OLD_STATUS{Com_delete}) ) / ($q_diff ),
                 );
        }
        else
        {
            print "\n";
        }
        $lines_left--;

        if ($have_query_cache and $STATUS{Com_select} and $query_cache_hits)
        {
          printf(" Cache Hits: %-5s Hits/s: %4.1f Hits now: %5.1f  Ratio: %4.1f%% Ratio now: %4.1f%% \n", 
                 make_short($STATUS{Qcache_hits}),        # cache hits
                 $STATUS{Qcache_hits} / $STATUS{Uptime}, # hits / sec
                 ($t_delta) ?  ($STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits}) / $t_delta : 0,  # now / s
                 # ratio: 
                 100 * ($STATUS{Qcache_hits})  / ($STATUS{Qcache_hits} + $STATUS{Com_select} ),
                 ($t_delta) ?   # ratio now
                 100 * ($STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits} ) /
                 ( ($STATUS{Com_select} + $STATUS{Qcache_hits} -
                    ($OLD_STATUS{Qcache_hits} + $OLD_STATUS{Com_select})
                   ) || 1) : 0,
                 );
        }
        $lines_left--;

        printf(" Key Efficiency: %2.1f%%  Bps in/out: %5s/%5s   ",
               $cache_hits_percent,
               make_short($STATUS{Bytes_received} / $STATUS{Uptime} ),
               make_short($STATUS{Bytes_sent} / $STATUS{Uptime}));
        printf("Now in/out: %5s/%5s",
               make_short(($STATUS{Bytes_received} - $OLD_STATUS{Bytes_received}) / $t_delta ),
               make_short(($STATUS{Bytes_sent} - $OLD_STATUS{Bytes_sent}) / $t_delta ))
          if ($t_delta);
        print "\n\n";

        $lines_left--;
    }


    ##
    ## Threads
    ##

    #my $sz = $width - 52;
    my @sz   = (8, 9, 15, 10, 9, 6);
    my $used = scalar(@sz) + Sum(@sz);
    my $free = $width - $used;

    print BOLD();

    printf "%8s %9s %15s %10s %9s %6s %-${free}s\n",
        'Id','User','Host/IP','DB','Time', 'Cmd', 'Query or State';

    print RESET();

    ##      Id User Host DB
    printf "%8s %9s %15s %10s %9s %6s %-${free}s\n",
        '--','----','-------','--','----', '---', '----------';

    $lines_left -= 2;

    my $proc_cmd = <<SQL;

SELECT datname         AS "db",
       pid             AS "Id",
       usename         AS "User",
       (
         CASE state
         WHEN 'idle' THEN 'Sleep'
         ELSE 'Query'
         END
       )               AS "Command",
       query           AS "Info",
       ROUND(EXTRACT(EPOCH FROM NOW() - query_start))
                       AS "Time",
       'local'         AS "Host"
  FROM pg_stat_activity
SQL

    my @data = Hashes($proc_cmd);

    foreach my $thread (@data)
    {
        last if not $lines_left;

        ## Drop Domain Name, unless it looks like an IP address.  If
        ## it's an IP, we'll strip the port number because it's rarely
        ## interesting.

        my $is_ip = 0;

        if ($thread->{Host} =~ /^(\d{1,3}\.){3}(\d{1,3})(:\d+)?$/)
        {
            $thread->{Host} =~ s/:.*$//;
            $is_ip = 1;
        }
        else
        {
            $thread->{Host} =~ s/^([^.]+).*/$1/;
        }
        
        ## Otherwise, look up the IP (if resolve is set) and strip the
        ## name
        if ($is_ip and $config{resolve})
        {
            $thread->{Host} =~ s/:\d+$//;
            my $host = gethostbyaddr(inet_aton($thread->{Host}), AF_INET);
            $host =~ s/^([^.]+).*/$1/;
            $thread->{Host} = $host;
        }

        ## Fix possible undefs

        $thread->{db}      ||= '';
        $thread->{Info}    ||= '';
        $thread->{Time}    ||= 0 ;
        $thread->{Id}      ||= 0 ;
        $thread->{User}    ||= '';
        $thread->{Command} ||= '';
        $thread->{Host}    ||= '';

        ## Normalize spaces -- mostly disabled for now.  This can
        ## break EXPLAIN if you try to explain a mangled query.  It
        ## may be re-enabled later as an option.

        ## leading space removal
        $thread->{Info} =~ s/^\s*//;

        ## remove newlines and carriage returns
        $thread->{Info} =~ s/[\n\r]//g;

        ## collpase whitespace
        $thread->{Info} =~ s/\s+/ /g;

        ## stow it in the cache
        my $tid = $thread->{Id};
        $qcache{$tid} = $thread->{Info};
        $dbcache{$tid} = $thread->{db};
        $ucache{$tid} = $thread->{User};

        my $is_query_running = $thread->{Command} eq 'Query';
        if ($is_query_running) {
            track_query_runtime($thread);
        }

    }

    ## Sort by idle time (closest thing to CPU usage I can think of).

    my @sorted;

    if (not $config{sort})
    {
        @sorted = sort { $a->{Time} <=> $b->{Time} } @data
    }
    else
    {
        @sorted = sort { $b->{Time} <=> $a->{Time} } @data
    }

    foreach my $thread (@sorted)
    {
        # Check to see if we can skip out.  We skip out if we know the
        # given line doesn't match.
        next if (not $config{idle}
                 and
                 ($thread->{Command} eq "Binlog Dump" || $thread->{Command} eq "Sleep"));

        next if ($thread->{User} !~ $config{filter_user});
        next if ($thread->{db}   !~ $config{filter_db});
        next if ($thread->{Host} !~ $config{filter_host});

        # Otherwise, print.

        my $smInfo;

        if ($thread->{Info})
        {
            $smInfo = substr $thread->{Info}, 0, $free;
        }
        elsif ($thread->{State})
        {
            $smInfo = substr $thread->{State}, 0, $free;
        }
        else
        {
            $smInfo = "";
        }

        if ($HAS_COLOR)
        {
            print YELLOW() if $thread->{Command} eq 'Query';
            print WHITE()  if $thread->{Command} eq 'Sleep';
            print GREEN()  if $thread->{Command} eq 'Connect';

            print BOLD() if $thread->{Time} > $config{slow_threshold};
        }

        printf "%8d %9.9s %15.15s %10.10s %9d %6.6s %-${free}.${free}s\n",
            $thread->{Id}, $thread->{User}, $thread->{Host}, $thread->{db},
            $thread->{Time}, $thread->{Command}, $smInfo;

        print RESET() if $HAS_COLOR;

        $lines_left--;

        last if $lines_left == 0;

    }

}

#
# Detect when a query has become slower than our threshold.
# Don't return true if a query is already past the slow threshold (200s f.ex.)
# We only want to log runaway queries once, when they cross the threshold.
#
sub is_runaway_query {
    my ($previous_runtime, $runtime_now) = @_;
    my $slow_threshold = 0 + $config{slow_threshold};
    my $has_crossed_over = $runtime_now > $slow_threshold
        && $previous_runtime > 0
        && $previous_runtime <= $slow_threshold;
    return $has_crossed_over;
}

sub log_runaway_query {
    my ($thread) = @_;

    my $query = $thread->{Info};
    $query =~ s{[\r\n\t]}{ }g;

    eval {
        open my $log_fh, '>>', 'pgtop.log';
        print $log_fh join("\t",
            scalar localtime(),
            $config{host},
            $thread->{db},
            $thread->{User},
            $thread->{Id},
            $thread->{Time},
            $query
        ) . "\n";
        close $log_fh;
    };

    my $msg = <<EOM;
Slow postgres query on `$config{host}` database `$thread->{db}` for user `$thread->{User}`
Query ID $thread->{Id} (has been running for $thread->{Time} s):

```
$thread->{Info}
```
EOM

    slack_message($msg);
}

sub slack_message {
    my $message = shift;
    my $webhook_url = $config{slack_webhook};
    return unless $webhook_url;
    my $ua = LWP::UserAgent->new();
    my $payload = JSON->new()->encode({ text => $message });
    $ua->post($webhook_url, Content=>$payload);
}

sub track_query_runtime {
    my $thread = shift;
    my $tid = $thread->{Id};

    my $previous_runtime = exists $historic_runtime{$tid}
        ? $historic_runtime{$tid}
        : 0;

    my $runtime_now = 0 + $thread->{Time};

    $runtime{$tid} = $runtime_now;

    if ($runtime_now > 0) {
        %historic_runtime = () if scalar keys %historic_runtime > 10000;
        $historic_runtime{$tid} = $runtime_now;
    }

    if (is_runaway_query($previous_runtime, $runtime_now)) {
        log_runaway_query($thread);
    }
}

###########################################################################

my $questions;

sub GetQPS()
{
    #my($data) = Hashes('SHOW STATUS LIKE "Questions"');
    my($data) = Hashes('show all');
    my $num   = $data->{Value};

    if (not defined $questions) ## first time?
    {
        $questions = $num;
        return;
    }

    my $qps = $num - $questions;
    $questions = $num;
    print "$qps\n";
}

###########################################################################

sub GetQcacheSummary()
{
}

###########################################################################

## TODO: add scrolling by line count

sub GetInnoDBStatus()
{
    my @data = Hashes("SHOW INNODB STATUS");
    print keys %{$data[0]};
    print $data[0]->{Status},"\n";
}

###########################################################################

my %prev_data;

sub GetCmdSummary()
{
    my ($width, $height, $wpx, $hpx, $lines_left);

    if (not $config{batchmode})
    {
        ($width, $height, $wpx, $hpx) = GetTerminalSize();

        $lines_left = $height - 2;
    }
    else
    {
        $height = 999_999;     ## I hope you don't have more than that!
        $lines_left = 999_999;
        $width = 80;
    }

    # Variable_name and Value pairs come back...
    # TODO
    #my @data = Hashes("SHOW STATUS LIKE 'Com_%'");
    my @data = Hashes("show all");
    my %cmd_data;
    my %cmd_delta;
    my %cmd_pct;
    my %cmd_delta_pct;
    my $total;
    my $delta_total;

    for my $item (@data)
    {
        next unless $item->{Value};
        $item->{Variable_name} =~ s/^Com_//;
        $item->{Variable_name} =~ s/_/ /g;
        $cmd_data{$item->{Variable_name}} = $item->{Value};
        $total += $item->{Value};
    }

    ## Populate other stats

    for my $item (keys %cmd_data)
    {
        $cmd_delta{$item} = $cmd_data{$item} -
            ($prev_data{$item} || $cmd_data{$item} -1 );

        $delta_total += $cmd_delta{$item};

        $cmd_pct{$item}  = int(($cmd_data{$item} / $total) * 100);
    }

    for my $item (keys %cmd_data)
    {
        $cmd_delta_pct{$item}  = int(($cmd_delta{$item} / $delta_total) * 100);
    }


    ## Display

    Clear() unless $config{batchmode};
    print RESET();
    printf "%18s %10s %4s  | %5s %4s\n", 'Command', 'Total', 'Pct', 'Last', 'Pct';
    printf "%18s %10s %4s  | %5s %4s\n", '-------', '-----', '---', '----', '---';
    $lines_left -= 2;

    for my $item (sort { $cmd_data{$b} <=> $cmd_data{$a} } keys %cmd_data)
    {
        printf "%18s %10d %4s  | %5d %4s\n",
            $item,
            $cmd_data{$item},
            $cmd_pct{$item} . "%",
            $cmd_delta{$item},
            $cmd_delta_pct{$item} . "%";

        last if not $lines_left;
        $lines_left -= 1;
    }

    %prev_data = %cmd_data;
}

###########################################################################

sub FullQueryInfo($)
{
    my $id = shift;

    if (not exists $qcache{$id} or not defined $qcache{$id})
    {
        print "*** Invalid id. ***\n";
        return;
    }

    my $sql = $qcache{$id};
    print $CLEAR;
    print "Thread $id was executing following query:\n\n";
    print YELLOW(), $sql,"\n\n", RESET();
}

###########################################################################

sub Explain($)
{
    my $id  = shift;

    if (not exists $qcache{$id} or not defined $qcache{$id})
    {
        print "*** Invalid id. ***\n";
        return;
    }

    my $sql = $qcache{$id};
    my $db  = $dbcache{$id};

    Execute("USE $db");
    my @info = Hashes("EXPLAIN $sql");
    print $CLEAR;
    print "EXPLAIN $sql:\n\n";
    PrintTable(@info);
}

###########################################################################

sub PrintTable(@)
{
    my $cnt = 1;
    my @cols = qw(table type possible_keys key key_len ref rows Extra);

    for my $row (@_)
    {
        print "*** row $cnt ***\n";
        for my $key (@cols)
        {
            my $val = $row->{$key} || 'NULL';
            printf "%15s:  %s\n", $key, $val;
        }
        $cnt++;
    }
}

###########################################################################

sub StringOrRegex($)
{
    my $input = shift;
    chomp $input;
    if (defined $input)
    {
        # regex, strip /.../ and use via qr//
        if ($input =~ m{^/} and $input =~ m{/$})
        {
            $input =~ s{^/}{} if $config{filter_user};
            $input =~ s{/$}{} if $config{filter_user};
            $input =  qr/$input/;
        }


        # reset to match anything
        elsif ($input eq '')
        {
            $input = qr/.*/;
        }

        # string, build a simple regex
        else
        {
            $input =  '^' . $input . '$';
            $input = qr/$input/;
        }
    }

    # reset to match anything
    else
    {
        $input = qr/.*/;
    }
    return $input;
}


###########################################################################

sub GetQuestions
{
    my $stref = $_[0];
    ReadMode($RM_RESET);
    my($stat) = Hashes(<<SQL);

SELECT sum(seq_scan)                     AS "Slow_queries",
       sum(seq_scan + idx_scan)          AS "Com_select",
       sum(seq_tup_read + idx_tup_fetch) AS "Com_tuples_selected",
       sum(n_tup_ins)                    AS "Com_insert",
       sum(n_tup_upd)                    AS "Com_update",
       sum(n_tup_del)                    AS "Com_delete"
  FROM pg_stat_user_tables
SQL

    $stref->{$_} = $stat->{$_}    for keys %$stat;

    #for(keys %$stat)
    #{
    #    warn('stat{'.$_.'} = {'.$stat->{$_}.'}');
    #}

    ## Server Uptime in meaningful terms...
    # TODO server's uptime? Now it is script start time
    $stref->{Uptime} = time() - $START_TIME;
    $stref->{Uptime} = 1 if $stref->{Uptime} == 0;

    # XXX
    # $stat->{com_insert, com_update, com_delete} are
    # n. of tuples, not n. of queries
    #
    #$stref->{Questions} = $stat->{com_select} + $stat->{com_insert} + $stat->{com_update} + $stat->{com_delete};
    my($stat_db) = Hashes(<<SQL);

SELECT sum(numbackends)                        AS "Threads_connected",
       (SELECT count(*) FROM pg_stat_activity) AS "Threads_running",
       0                                       AS "Threads_cached",
       sum(xact_commit + xact_rollback)        AS "Questions"
  FROM pg_stat_database
SQL

    # Slow queries here is n. of `seq_scan' queries
    $stref->{$_} = $stat_db->{$_} for keys %$stat_db;

    $stref->{Questions} = 1 if $stref->{Questions} == 0;
}



###########################################################################

sub cmd_s
{
    ReadMode($RM_RESET);

    print RED(), "Seconds of Delay: ", RESET();
    my $secs = ReadLine(0);

    if ($secs =~ /^\s*(\d+)/)
    {
        $config{delay} = $1;
        if ($config{delay} < 1)
        {
            $config{delay} = 1;
        }
    }
    ReadMode($RM_NOBLKRD);
}

sub cmd_q
{
    ReadMode($RM_RESET);
    print "\n";
    exit;
}

###########################################################################

sub PrintHelp()
{
    my $help = qq[
Help for pgtop version $main::VERSION by Cosimo Streppone <${YELLOW}cosimo\@cpan.org${RESET}>

  ? - display this screen
  # - toggle short/long numbers (not yet implemented)
  c - command summary view (based on Com_* counters)
  d - show only a specific database
  e - explain the query that a thread is running
  f - show full query info for a given thread
  F - unFilter the dispaly
  h - show only a specifc host's connections
  H - toggle the mytop header
  i - toggle the display of idle (sleeping) threads
  I - show innodb status
  k - kill a thread
  p - pause the display
  m - switch [mode] to qps (queries/sec) scrolling view
  o - reverse the sort order (toggle)
  q - quit
  r - reset the status counters (via FLUSH STATUS on your server)
  s - change the delay between screen updates
  t - switch to thread view (default)
  u - show only a specific user
  : - enter a command (not yet implemented)

${GREEN}http://www.streppone.it/cosimo/perl/pgtop/${RESET}
];

    print $help;
}

sub Sum(@)
{
    my $sum;
    while (my $val = shift @_) { $sum += $val; }
    return $sum;
}

## A useful routine from perlfaq

sub commify($)
{
    local $_  = shift;
    return 0 unless defined $_;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
    return $_;
}

## Compact numeric representation (10,000 -> 10.0k)

sub make_short($)
{
    my $number = shift;
    return commify($number) if $config{long_nums};
    my $n = 0;
    while ($number > 1_025) { $number /= 1024; $n++; };
    return sprintf "%.1f%s", $number, ('','k','M','G', 'T')[$n];
}



## Run a query and return the records has an array of hashes.

sub Hashes($)
{
    my $sql = shift;
    my @records;

    if (my $sth = Execute($sql))
    {
        while (my $ref = $sth->fetchrow_hashref)
        {
            print "record\n" if $debug;
            push @records, $ref;
        }
    }
    return @records;
}

## Execute an SQL query and return the statement handle.

sub Execute($)
{
    my $sql = shift;
    my $sth = $dbh->prepare($sql);

    if (not $sth) { ReadMode($RM_RESET); die $DBI::errstr; }

    my $ReturnCode = $sth->execute;

    if (not $ReturnCode)
    {
        if ($debug)
        {
            print "query failed\n";
            sleep 10;
        }
        return undef;
    }

    return $sth;
}



=pod

=head1 SYNOPSIS

B<pgtop> [options]

=head1 AVAILABILITY

The latest version of B<pgtop> is available from
L<https://metacpan.org/author/COSIMO> or on github
at L<https://github.com/cosimo/pgtop>.

=head1 REQUIREMENTS

In order for B<pgtop> to function properly, you must have the
following:

  * Perl 5.014 or newer
  * Getopt::Long
  * DBI and DBD::Pg
  * Term::ReadKey

Most systems are likely to have all of those installed or readily available.

And you obviously need access to a PostgreSQL server (version 7.2+)
with the necessary security to access the I<pg_stat*> relations. 

=head2 Optional Color Support

In additon, if you want a color B<mytop> (recommended), install
Term::ANSIColor from the CPAN:

    https://metacpan.org/module/Term::ANSIColor

Once you do, B<pgtop> will automatically use it. However, color is not
yet working on Windows. Patches welcome. :-)

=head2 Optional Hi-Res Timing

If you want B<pgtop> to provide more accurate real-time
queries-per-second statistics, install the Time::HiRes module from
CPAN.  B<pgtop> will automatically notice that you have it and use it
rather than the standard timing mechanism.

=head2 Platforms

B<pgtop> currently is known to work only on Linux. Its `mytop' brother,
however, has been reported to work on:

  * Linux (2.2.x, 2.4.x) ?
  * FreeBSD (2.2, 3.x, 4.x) ?
  * Mac OS X ?
  * BSDI 4.x ?
  * Solaris 2.x ?
  * Windows NT 4.x (ActivePerl) ?

If you find that it works on another platform, please let us 
know. Given that it is all Perl code, I expect it to be rather
portable to Unix and Unix-like systems. Heck, it I<might> even work on
Win32 systems.

=head1 DESCRIPTION

Help is always welcome in improving this software. Feel free to
contact the author (see L<"AUTHOR"> below) with bug reports, fixes,
suggestions, and comments. Additionally L<"BUGS"> will provide a list
of things this software is not able to do yet.

Having said that, here are the details on how it works and what you can
do with it.

=head2 The Basics

B<pgtop> was inspired by B<mytop> (http://mytop.sourceforge.net/), which
in turn was inspired by the system monitoring tool B<top>.

B<pgtop> will connect to a PostgreSQL server and periodically run
queries against the B<pg_stat*> relations and attempt to
summarize the information from them in a useful format.

=head2 WHAT FOLLOWS REFERS TO MYTOP

What you read from now on has not been revised, and refers
to the original utility C<mytop>.

=head2 The Display

The B<mytop> display screen is really broken into two parts. The top 4
lines (header) contain summary information about your MySQL
server. For example, you might see something like:

MySQL on localhost (4.0.13-log)                        up 1+11:13:00 [23:29:11]
 Queries: 19.3M  qps:  160 Slow:     1.0         Se/In/Up/De(%):    00/80/03/17
             qps now:  219 Slow qps: 0.0  Threads:    1 (   1/  16) 00/74/00/25
 Key Efficiency: 99.3%  Bps in/out: 30.5k/162.8   Now in/out: 32.7k/ 3.3k

The first line identifies the hostname of the server (localhost) and
the version of MySQL it is running. The right had side shows the
uptime of the MySQL server process in days+hours:minutes:seconds
format (much like FreeBSD's top) as well as the current time.

The second line displays the total number of queries the server has
processed, the average number of queries per second, the number of
slow queries, and the percentage of Select, Insert, Update, and Delete
queries.

The third real-time values. First is the number of queries per second,
then the number of slow queries, followed by query precentages (like
on the previous line).

And the fourth line displays key buffer efficiency (how often keys are
read from the buffer rather than disk) and the number of bytes that
MySQL has sent and received, both over all and in the last cycle.

You can toggle the header by hitting B<h> when running B<mytop>.

The second part of the display lists as many threads as can fit on
screen. By default they are sorted according to their idle time (least
idle first). The display looks like:

    Id     User       Host      Dbase   Time      Cmd Query or State
    --     ----       ----      -----   ----      --- --------------
    61  jzawodn  localhost      music      0    Query show processlist

As you can see, the thread id, username, host from which the user is
connecting, database to which the user is connected, number of seconds
of idle time, the command the thread is executing, and the query info
are all displayed.

Often times the query info is what you are really interested in, so it
is good to run B<mytop> in an xterm that is wider than the normal 80
columns if possible.

The thread display color-codes the threads if you have installed color
support. The current color scheme only works well in a window with a
dark (like black) background. The colors are selected according to the
C<Command> column of the display:

    Query   -  Yellow
    Sleep   -  White
    Connect -  Green

Those are purely arbitrary and will be customizable in a future
release. If they annoy you just start B<mytop> with the B<-nocolor>
flag or adjust your config file appropriately.

=head2 Arguments

B<mytop> handles long and short command-line arguments. Not all
options have both long and short formats, however. The long arguments
can start with one or two dashes `-' or `--'. They are shown here with
just one.

=over

=item B<-u> or B<-user> username

Username to use when logging in to the MySQL server. Default: ``root''.

=item B<-p> or B<-pass> or B<-password> password

Password to use when logging in to the MySQL server. Default: none.

=item B<-h> or B<-host> hostname[:port]

Hostname of the MySQL server. The hostname may be followed by an
option port number. Note that the port is specified separate from the
host when using a config file. Default: ``localhost''.

=item B<-port> or B<-P> port

If you're running MySQL on a non-standard port, use this to specify
the port number. Default: 3306.

=item B<-s> or B<-delay> seconds

How long between display refreshes. Default: 5

=item B<-d> or B<-db> or B<-database> database

Use if you'd like B<mytop> to connect to a specific database by
default. Default: ``test''.

=item B<-b> or B<-batch> or B<-batchmode>

In batch mode, mytop runs only once, does not clear the screen, and
places no limit on the number of lines it will print. This is suitable
for running periodically (perhaps from cron) to capture the
information into a file for later viewing. You might use batch mode in
a CGI script to occasionally display your MySQL server status on the
web.

Default: unset.

=item B<-S> or B<-socket> /path/to/socket

If you're running B<mytop> on the same host as MySQL, you may wish to
have it use the MySQL socket directly rather than a standard TCP/IP
connection. If you do,just specify one.

Note that specifying a socket will make B<mytop> ignore any host
and/or port that you might have specified. If the socket does not
exist (or the file specified is not a socket), this option will be
ignored and B<mytop> will use the hostname and port number instead.

Default: none.

=item B<-header> or B<-noheader>

Sepcify if you want the header to display or not. You can toggle this
with the B<h> key while B<mytop> is running.

Default: header.

=item B<-color> or B<-nocolor>

Specify if you want a color display. This has no effect if you don't
have color support available.

Default: If you have color support, B<mytop> will try color unless you
tell it not to.

=item B<-i> or B<-idle> or B<-noidle>

Specify if you want idle (sleeping) threads to appear in the list. If
sleeping threads are omitted, the default sorting order is reversed so
that the longest running queries appear at the top of the list.

Default: idle.

=item B<-prompt> or B<-noprompt>

Specify if you want to be prompted to type in your database password.
This provides a little bit more security since it not only prevents
the password from viewable in a process list, but also doesn't require
the password to be stored in plain text in your ~/.mytop config file.
You will B<only> be prompted if a password has not been specified in
your config file or through another command line option.

Default: noprompt.

=item B<-resolve>

If you have skip-resolve set on MySQL (to keep it from doing a reverse
DNS lookup on each inbound connection), mytop can replace IP addresses
with hostnames but toggling this option.

Default: noresolve

=item B<-slow_threshold>

Defines the threshold in seconds after which a query must be considered
slow and it's logged to a file (`pgtop.log`).

Default: 60

=item B<-slack_webhook>

If provided, in the form of a slack incoming webhook URL (e.g.
L<https://hooks.slack.com/services/...>), it will be used to send notifications
for queries that are running longer than C<slow_threshold> seconds.

There is no default value, so no slack notification will be sent if this
parameter is not provided.

Default: none

=back

Command-line arguments will always take precedence over config file
options. That happens because the config file is read I<BEFORE> the
command-line arguments are applied.

=head2 Config File

Instead of always using bulky command-line parameters, you can also
use a config file in your home directory (C<~/.pgtop>). If present,
B<pgtop> will read it automatically. It is read I<before> any of your
command-line arguments are processed, so your command-line arguments
will override directives in the config file.

Here is a sample config file C<~/.pgtop> which implements the defaults
described above.

  user=root
  pass=
  host=localhost
  db=test
  delay=5
  port=3306
  batchmode=0
  header=1
  color=1
  idle=1

Using a config file will help to ensure that your database password
isn't visible to users on the command-line. Just make sure that the
permissions on C<~/.pgtop> are such that others cannot read it (unless
you want them to, of course).

You may have white space on either side of the C<=> in lines of the
config file.

=head2 Shortcut Keys

The following keys perform various actions while B<mytop> is
running. Those which have not been implemented are listed as
such. They are included to give the user idea of what is coming.

=over

=item B<?>

Display help.

=item B<c>

Show "command counters" based on the Com_* values in SHOW STATUS.
This is a new feature.  Feedback welcome.

=item B<d>

Show only threads connected to a particular database.

=item B<f>

Given a thread id, display the entire query that thread was (and still
may be) running.

=item B<F>

Disable all filtering (host, user, and db).

=item B<h>

Only show queries from a particular host.

=item B<H>

Toggle the header display. You can also specify either C<header=0> or
C<header=1> in your config file to set the default behavior.

=item B<i>

Toggle the display of idle (sleeping) threads. If sleeping threads are
filtered, the default sorting order is reversed so that the longest
running queries appear at the top of the list.

=item B<k>

Kill a thread.

=item B<K>

Kill all threads/queries that have been running for longer than a given
threshold in seconds.

=item B<m>

Toggle modes. Currently this switches from `top' mode to `qps'
(Queries Per Second Mode). In this mode, mytop will write out one
integer per second. The number written reflects the number of queries
executed by the server in the previous one second interval.

More modes may be added in the future.

=item B<o>

Reverse the default sort order.

=item B<p>

Pause display.

=item B<q>

Quit B<pgtop>

=item B<r>

Reset the server's status counters via a I<FLUSH STATUS> command.

=item B<s>

Change the sleep time (number of seconds between display refreshes).

=item B<u>

Show only threads owned by a giver user.

=back

The B<s> key has a command-line counterpart: B<-s>.

The B<h> key has two command-line counterparts: B<-header> and
B<-noheader>.

=head1 BUGS

Probably many, but C<pgtop> is still quite useful.

=head1 AUTHOR

pgtop was adapted from mytop and is maintained by Cosimo Streppone
(C<cosimo@cpan.org>).

mytop was developed and is maintained by Jeremy D. Zawodny
(C<Jeremy@Zawodny.com>).

If you wish to e-mail me regarding this software, please do!

=head1 DISCLAIMER

This is certainly not a quality work, but before this crap, there
was nothing but pg_stat_* tables. Just like Jeremy, I needed
something more immediate and usable, like B<top>.

To tell the real truth, I didn't even know about B<pg_stat> tables. :-)

There is huge room for improvement!

=head1 COPYRIGHT

Copyright (C) 2005-2020, Cosimo Streppone.
Copyright (C) 2000-2001, Jeremy D. Zawodny.

=head1 MYTOP CREDITS

Fix a bug. Add a feature. See your name here!

Many thanks go to these fine folks:

=over

=item Sami Ahlroos (sami@avis-net.de)

Suggested the idle/noidle stuff.

=item Jan Willamowius (jan@janhh.shnet.org)

Mirnor bug report. Documentation fixes.

=item Alex Osipov (alex@acky.net)

Long command-line options, Unix socket support.

=item Stephane Enten (tuf@grolier.fr)

Suggested batch mode.

=item Richard Ellerbrock (richarde@eskom.co.za)

Bug reports and usability suggestions.

=item William R. Mattil (wrm@newton.irngtx.tel.gte.com)

Bug report about empty passwords not working.

=item Benjamin Pflugmann (philemon@spin.de)

Suggested -P command-line flag as well as other changes.

=item Justin Mecham <justin@aspect.net>

Suggested setting $0 to `mytop'.

=item Thorsten Kunz <thorsten.kunz@de.tiscali.com>

Provided a fix for cases when we try remove the domain name from the
display even if it is actually an IP address.

=item Sasha Pachev <sasha@mysql.com>

Provided the idea of real-time queries per second in the main display.

=item Paul DuBois <paul@snake.net>

Pointed out some option-handling bugs.

=item Mike Wexler <mwexler@tias.com>

Suggested that we don't mangle (normalize) whitespace in query info by
default.

=item Mark Zweifel <markez@yahoo-inc.com>

Make the --idle command-line argument negatable.

=item Axel Schwenke <schwenke@jobpilot.de>

Noticed the inccorect formula for query cache hit percentages in
version 1.2.

=item Steven Roussey <sroussey@network54.com>

Supplied a patch to help filter binary junk in queries so that
terminals don't freak out.

=item jon r. luini <falcon@chime.com>

Supplied a patch that formed the basis for C<-prompt> support.  Sean
Leach <sleach@wiggum.com> submitted a similar patch.

=item Yogish Baliga <baliga@yahoo-inc.com>

Supplied a patch that formed the basis for C<-resolve> support.

=item Per Andreas Buer <perbu@linpro.no>

Supplied an excellent patch to tidy up the top display.  This includes
showing most values in short form, such as 10k rather than 10000.

=back

See the Changes file on the B<pgtop> distribution page for more
details on what has changed.

=head1 LICENSE

B<pgtop> is licensed under the GNU General Public License version
2. For the full license information, please visit
http://www.gnu.org/copyleft/gpl.html

=cut

__END__