redis-top-pack

#!/usr/bin/env perl


# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"App/RedisTop.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP';
  package App::RedisTop;
  use strict;
  use warnings;
  our $VERSION = '0.03';
  
  1;
  __END__
  
  =head1 NAME
  
  App::RedisTop - Redis resource statistics tool.
  
  =head1 DESCRIPTION
  
  Redis resource statistics tool.
  
  =head1 AUTHOR
  
  Tsuyoshi Torii E<lt>toritsuyo(at)cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<redis-top>
  
  =head1 THANKS TO
  
  hirose31
  
  fujiwara
  
  =head1 LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
APP_REDISTOP

$fatpacked{"App/RedisTop/Component.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT';
  package App::RedisTop::Component;
  use Term::ANSIColor qw/colored/;
  
  sub new {
      my $class = shift;
  
      my %args = @_;
      my $self = bless {
          redis_config => $args{redis_config},
      }, $class;
  }
  
  sub redis_config {
      my ($self, $value) = @_;
      if($value) {
          $self->{redis_config} = $value;
      }
      return $self->{redis_config};
  }
  
  sub stat_values {
      my ($self, $stat, $prev_stat) = @_;
      my @results;
      for my $row (@{$self->{items}}) {
          my $stat_key = ref $row->{stat_key} eq 'CODE' ? $row->{stat_key}->($stat->{redis_version}) : $row->{stat_key};
          my $value;
          if ($row->{diff}) {
              my $prev_uptime = $prev_stat->{uptime_in_seconds} || 0;
              my $prev_value  = $prev_stat->{$stat_key} || 0;
              eval {
                  $value
                      = ( $stat->{$stat_key} - $prev_value )
                      / ( $stat->{uptime_in_seconds} - $prev_uptime);
              };
              if ($@) {
                  $value = $stat->{$stat_key};
              }
          } elsif($row->{denominator_key}) {
              if($self->redis_config && $self->redis_config->{$row->{denominator_key}}) {
                  $value = sprintf("%.2f", ($stat->{$stat_key} / $self->redis_config->{$row->{denominator_key}}) * 100);
              } else {
                  $value = "-1";
              }
          } elsif($row->{data}) {
              $value = $row->{data}->();
          } else {
              $value = $stat->{$stat_key};
          }
          push @results, $value;
      }
      return @results;
  }
  
  sub unit {
      my ($self, $value) = @_;
      $value ||= 0;
  
      my $round = '';
      my @units = qw/K M G T P/;
      unshift @units, ' ';
      for my $unit (@units) {
          if($value / 1000 < 1) {
              $round = 2 if index($value, '.') > 0; # float
              return sprintf("%.${round}f%s", $value, $unit);
          }
          $value = $value / 1000;
          $round = 2;
      }
  }
  
  sub separator { colored("|", "blue") }
  
  sub header {
      my ($self) = @_;
      my $title = $self->{group};
      my $diff  = $self->component_width - length($title);
      my $left  = $diff / 2;
      my $right = $diff - $left;
  
      my $line     = '-' x $left . $title . '-' x $right;
      my $line_len = length($line);
      if($line_len > $self->component_width-1) {
          $line = substr($line, 0, length($line)-1);
      } elsif($line_len < $self->component_width-1) {
          $line .= '-';
      }
      return colored("${line} ", "blue");
  }
  
  sub sub_header {
      my ($self) = @_;
      my $format = "%" . $self->{width} . "s";
      my $line   = join(' ', map { sprintf($format, $_->{name}) } @{$self->{items}});
      return colored("${line}", "cyan") . $self->separator;
  }
  
  sub line {
      my ($self, $spt) = @_;
      my $item_len = scalar @{$self->{items}};
      my $line     = join(' ', map { $spt x $self->{width} } 1..$item_len);
      return colored("${line} ", "blue");
  }
  
  sub component_width {
      my ($self) = @_;
      my $line = $self->line('-');
      return length($self->colorstrip($self->line('-')));
  }
  
  sub colorstrip {
      my ($self, @string) = @_;
      for my $string (@string) {
          $string =~ s{ \e\[ [\d;]* m }{}xmsg;
      }
      return wantarray ? @string : join q{}, @string;
  }
  
  sub body {
      my ($self, $stat, $prev_stat) = @_;
      my @cols;
      for my $value ($self->stat_values($stat, $prev_stat)) {
          my $stat   = ($self->{unit}) ? $self->unit($value) : $value;
          my $format = ($self->{round}) ? "%" . $self->{width} . ".1f" : "%" . $self->{width} . "s" ;
          push @cols, sprintf($format, $stat);
      }
      my $line = join(' ', @cols);
      return $line . $self->separator;
  }
  
  sub average {
      my ($self, $values, $instance_count) = @_;
      $values ||= [ map { '' } @{$self->{items}} ];
  
      my @cols;
      for my $value (@$values) {
          my $avg_value = 0;
          $avg_value = $value / $instance_count if $value && $instance_count;
  
          my $stat   = ($self->{unit}) ? $self->unit($avg_value) : $avg_value;
          my $format = ($self->{round}) ? "%" . $self->{width} . ".1f" : "%" . $self->{width} . "s" ;
          push @cols, sprintf($format, $stat);
      }
      my $line = join(' ', @cols);
      return $line . $self->separator;
  }
  
  sub total {
      my ($self, $values) = @_;
  
      my @cols;
      for my $value (@$values) {
          my $stat = '';
          if($self->{total}){
              $stat = ($self->{unit}) ? $self->unit($value) : $value;
          }
          my $format = "%" . $self->{width} . "s";
          push @cols, sprintf($format, $stat);
      }
      my $line = join(' ', @cols);
      return $line . $self->separator;
  }
  
  1;
APP_REDISTOP_COMPONENT

$fatpacked{"App/RedisTop/Component/CPU.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_CPU';
  package App::RedisTop::Component::CPU;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
      my $self = bless {
          group => 'cpu',
          items => [
              { name => 'sys', stat_key => 'used_cpu_sys',  diff => 1 },
              { name => 'usr', stat_key => 'used_cpu_user', diff => 1 },
          ],
          width => 6,
          round => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_CPU

$fatpacked{"App/RedisTop/Component/Command.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_COMMAND';
  package App::RedisTop::Component::Command;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'command',
          items => [
              { name => 'total/s',  stat_key => 'total_commands_processed', diff => 1 },
              { name => 'hits/s',   stat_key => 'keyspace_hits',   diff => 1 },
              { name => 'misses/s', stat_key => 'keyspace_misses', diff => 1 },
          ],
          width => 8,
          unit  => 1,
          total => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_COMMAND

$fatpacked{"App/RedisTop/Component/Connection.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_CONNECTION';
  package App::RedisTop::Component::Connection;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'conn',
          items => [
              { name => 'total/s',   stat_key => 'total_connections_received', diff => 1 },
              { name => 'clients',   stat_key => 'connected_clients', },
          ],
          width => 9,
          unit  => 1,
          total => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_CONNECTION

$fatpacked{"App/RedisTop/Component/ConnectionPer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_CONNECTIONPER';
  package App::RedisTop::Component::ConnectionPer;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'connper',
          items => [
              { name => 'conn/max', stat_key => 'connected_clients', denominator_key => 'maxclients'},
          ],
          width => 9,
          total => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_CONNECTIONPER

$fatpacked{"App/RedisTop/Component/DB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_DB';
  package App::RedisTop::Component::DB;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'db',
          items => [
              { name => 'keys',    stat_key => 'keys', },
              { name => 'expires', stat_key => 'expires', },
          ],
          width => 7,
          unit  => 1,
          total => 1,
          dbid  => 0,
          @_,
      }, $class;
      # set group name
      $self->{group} = $self->{group} . $self->{dbid};
      $self;
  }
  
  # override
  sub stat_values {
      my ($self, $stat) = @_;
      my @results;
      my $db_key = "db" . $self->{dbid};
      my $value  = $stat->{$db_key} || "keys=0,expires=0";
      my ($keys, $expires) = map {$_ =~ /keys=(\d+),expires=(\d+)/; $1, $2} ($value);
      return ($keys, $expires);
  }
  
  1;
APP_REDISTOP_COMPONENT_DB

$fatpacked{"App/RedisTop/Component/Epoch.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_EPOCH';
  package App::RedisTop::Component::Epoch;
  use base 'App::RedisTop::Component';
  use POSIX qw(strftime);
  
  sub new {
      my $class = shift;
      my $self = bless {
          group => 'date/time',
          items => [
              { name => 'epoch', callback => sub { return strftime("%s", localtime()) }, },
          ],
          width => 10,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_EPOCH

$fatpacked{"App/RedisTop/Component/Instance.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_INSTANCE';
  package App::RedisTop::Component::Instance;
  use base 'App::RedisTop::Component';
  use POSIX qw(strftime);
  
  sub new {
      my $class = shift;
      my $self = bless {
          group => 'instance',
          items => [
              {
                  name => 'instance',
                  callback => sub {
                      my ($redis_instance, $redis_config) = @_;
                      return $redis_instance;
                  },
              },
          ],
          width => 15,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_INSTANCE

$fatpacked{"App/RedisTop/Component/Memory.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_MEMORY';
  package App::RedisTop::Component::Memory;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'mem',
          items => [
              { name => 'use',  stat_key => 'used_memory', },
              { name => 'rss',  stat_key => 'used_memory_rss', },
              { name => 'frag', stat_key => 'mem_fragmentation_ratio', },
          ],
          width => 7,
          unit  => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_MEMORY

$fatpacked{"App/RedisTop/Component/MemoryPer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_MEMORYPER';
  package App::RedisTop::Component::MemoryPer;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'memper',
          items => [
              { name => 'use/max', stat_key => 'used_memory', denominator_key => 'maxmemory'},
          ],
          width => 8,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_MEMORYPER

$fatpacked{"App/RedisTop/Component/Save.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_SAVE';
  package App::RedisTop::Component::Save;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'save',
          items => [
              {
                  name     => 'changes',
                  stat_key => sub {
                      my $redis_version = shift;
                      return $redis_version =~ /^2\.4/
                          ? 'changes_since_last_save'
                          : 'rdb_changes_since_last_save';
                  },
              },
             ],
          width => 7,
          unit  => 1,
          total => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_SAVE

$fatpacked{"App/RedisTop/Component/Slowlog.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_SLOWLOG';
  package App::RedisTop::Component::Slowlog;
  use base 'App::RedisTop::Component';
  sub new {
      my $class = shift;
  
      my $self = bless {
          group => 'slowlog',
          items => [
              { name => 'slowlog', stat_key => 'slowlog_len', },
          ],
          width => 9,
          unit  => 1,
          total => 1,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_SLOWLOG

$fatpacked{"App/RedisTop/Component/Time.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_COMPONENT_TIME';
  package App::RedisTop::Component::Time;
  use base 'App::RedisTop::Component';
  use POSIX qw(strftime);
  
  sub new {
      my $class = shift;
      my $self = bless {
          group => 'date/time',
          items => [
              { name => 'time', data => sub { strftime("%m/%d %H:%M:%S", localtime()) }, },
          ],
          width => 15,
          @_,
      }, $class;
  }
  
  1;
APP_REDISTOP_COMPONENT_TIME

$fatpacked{"App/RedisTop/Perform.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_PERFORM';
  package App::RedisTop::Perform;
  use Term::ANSIColor qw/colored/;
  use List::Util qw/max/;
  use App::RedisTop::Redis;
  
  my $version = eval {
      require App::RedisTop;
      $App::RedisTop::VERSION;
  };
  if($@) { $version = '?' }
  
  sub new {
      my $class = shift;
  
      my $self = bless {
          groups     => [],
          instances  => [],
          width      => 20,
          summary    => {},
          prev_stats => {},
          @_,
      }, $class;
      my $max_len = max (map { length($_) } @{$self->{instances}});
      $self->{width} = $max_len;
      $self;
  }
  
  sub separator { colored("|", "blue") }
  
  sub build_title {
      my @lines;
      push @lines, "\033[2J\n";
      push @lines, colored(sprintf("redis-top v%s\n\n", $version), "bold");
      return @lines;
  }
  
  sub build_header {
      my ($self) = @_;
      my $out_str = sprintf("%s ", ' ' x $self->{width});
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->header;
      }
      return ("$out_str\n");
  }
  
  sub build_sub_header {
      my ($self) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'INSTANCE', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->sub_header;
      }
      return ("$out_str\n");
  }
  
  sub build_line {
      my ($self, $spt) = @_;
      my $out_str = colored(sprintf("%s ", $spt x $self->{width}), "blue");
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->line($spt);
      }
      return ("$out_str\n");
  }
  
  sub build_body {
      my ($self, $instance, $stats, $prev_stats, $redis_config) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = sprintf($format, $instance, $self->separator);
      for my $group (@{$self->{groups}}) {
          $group->redis_config($redis_config);
          $out_str .= $group->body($stats, $prev_stats);
  
          # stash total count
          my @values = $group->stat_values($stats, $prev_stats);
          my $key    = $group->{group};
          my $total_values = $self->{summary}->{$key} || [];
          for (my $i = 0; $i < scalar @values; $i++){
              $total_values->[$i] ||= 0;
              $total_values->[$i] += $values[$i];
          }
          $self->{summary}->{$key} = $total_values;
      }
      return ("$out_str\n");
  }
  
  sub build_average {
      my ($self) = @_;
      my $instance_count = scalar @{$self->{instances}};
  
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'AVERAGE', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          my $key   = $group->{group};
          $out_str .= $group->average($self->{summary}->{$key}, $instance_count);
      }
      return ("$out_str\n");
  }
  
  sub build_total {
      my ($self) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'TOTAL', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          my $key   = $group->{group};
          $out_str .= $group->total($self->{summary}->{$key});
      }
      return ("$out_str\n");
  }
  
  sub run {
      my ($self) = @_;
  
      # init total
      $self->{summary} = {};
  
      my @lines;
      # build header
      push @lines, $self->build_title;
      push @lines, $self->build_header;
      push @lines, $self->build_sub_header;
      push @lines, $self->build_line('-');
  
      # instances loop
      foreach my $instance (@{$self->{instances}}) {
          my ($host, $port) = split(/:/, $instance);
  
          my $redis   = App::RedisTop::Redis->new(host => $host, port => $port);
          my $config  = $redis->config();
          my $stats   = $redis->info();
          my $slowlog = $redis->slowlog();
          # add slowlog len into stats
          $stats->{slowlog_len} = $slowlog;
  
          push @lines, $self->build_body(
              $instance,
              $stats,
              $self->{prev_stats}->{$instance} || {},
              $config,
          );
          $self->{prev_stats}->{$instance} = $stats;
      }
  
      # average
      push @lines, $self->build_line(' ');
      push @lines, $self->build_average();
      # total
      push @lines, $self->build_line(' ');
      push @lines, $self->build_total();
  
      print join('', @lines);
  }
  
  1;
APP_REDISTOP_PERFORM

$fatpacked{"App/RedisTop/PerformStat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_PERFORMSTAT';
  package App::RedisTop::PerformStat;
  use Term::ANSIColor qw/colored/;
  use List::Util qw/max/;
  use App::RedisTop::Redis;
  
  my $version = eval {
      require App::RedisTop;
      $App::RedisTop::VERSION;
  };
  if($@) { $version = '?' }
  
  sub new {
      my $class = shift;
  
      chomp(my $rows = qx{tput lines});
      $rows ||= 24;
  
      my $self = bless {
          groups     => [],
          instances  => [],
          width      => 20,
          summary    => {},
          prev_stats => {},
          displayed  => 0,
          rows       => $rows,
          @_,
      }, $class;
      my $max_len = max (map { length($_) } @{$self->{instances}});
      $self->{width} = $max_len;
      $self;
  }
  
  sub separator { colored("|", "blue") }
  
  sub build_title {
      return ();
  }
  
  sub build_header {
      my ($self) = @_;
      my $out_str = sprintf("%s ", ' ' x $self->{width});
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->header;
      }
      return ("$out_str\n");
  }
  
  sub build_sub_header {
      my ($self) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'INSTANCE', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->sub_header;
      }
      return ("$out_str\n");
  }
  
  sub build_line {
      my ($self, $spt) = @_;
      my $out_str = colored(sprintf("%s ", $spt x $self->{width}), "blue");
      for my $group (@{$self->{groups}}) {
          $out_str .= $group->line($spt);
      }
      return ("$out_str\n");
  }
  
  sub build_body {
      my ($self, $instance, $stats, $prev_stats, $redis_config) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = sprintf($format, $instance, $self->separator);
      for my $group (@{$self->{groups}}) {
          $group->redis_config($redis_config);
          $out_str .= $group->body($stats, $prev_stats);
  
          # stash total count
          my @values = $group->stat_values($stats, $prev_stats);
          my $key    = $group->{group};
          my $total_values = $self->{summary}->{$key} || [];
          for (my $i = 0; $i < scalar @values; $i++){
              $total_values->[$i] ||= 0;
              $total_values->[$i] += $values[$i];
          }
          $self->{summary}->{$key} = $total_values;
      }
      return ("$out_str\n");
  }
  
  sub build_average {
      my ($self) = @_;
      my $instance_count = scalar @{$self->{instances}};
  
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'AVERAGE', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          my $key   = $group->{group};
          $out_str .= $group->average($self->{summary}->{$key}, $instance_count);
      }
      return ("$out_str\n");
  }
  
  sub build_total {
      my ($self) = @_;
      my $format = "%" . $self->{width} . "s%s";
      my $out_str = colored(sprintf($format, 'TOTAL', $self->separator), "bold");
      for my $group (@{$self->{groups}}) {
          my $key   = $group->{group};
          $out_str .= $group->total($self->{summary}->{$key});
      }
      return ("$out_str\n");
  }
  
  sub run {
      my ($self) = @_;
  
      # init total
      $self->{summary} = {};
  
      my @lines;
      if ($self->{displayed} == 0) {
          # build header
          push @lines, $self->build_title;
          push @lines, $self->build_header;
          push @lines, $self->build_sub_header;
          push @lines, $self->build_line('-');
      }
  
      # instances loop
      foreach my $instance (@{$self->{instances}}) {
          my ($host, $port) = split(/:/, $instance);
  
          my $redis   = App::RedisTop::Redis->new(host => $host, port => $port);
          my $config  = $redis->config();
          my $stats   = $redis->info();
          my $slowlog = $redis->slowlog();
          # add slowlog len into stats
          $stats->{slowlog_len} = $slowlog;
  
          push @lines, $self->build_body(
              $instance,
              $stats,
              $self->{prev_stats}->{$instance} || {},
              $config,
          );
          $self->{prev_stats}->{$instance} = $stats;
      }
  
      if ($self->{displayed} == 0) {
          # average
          push @lines, $self->build_average();
          # total
          push @lines, $self->build_total();
      }
  
      print join('', @lines);
      $self->{displayed} += scalar(@lines);
      if ($self->{displayed} >= $self->{rows}) {
          $self->{displayed} = 0;
      }
  }
  
  1;
APP_REDISTOP_PERFORMSTAT

$fatpacked{"App/RedisTop/Redis.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_REDISTOP_REDIS';
  package App::RedisTop::Redis;
  
  use strict;
  use warnings;
  use IO::Socket::INET;
  
  sub new {
      my $class = shift;
      my (%args) = @_;
  
      my $host = $args{host} || '127.0.0.1';
      my $port = $args{port} || '6379';
      my $pass = $args{pass};
  
      my $server = "$host:$port";
      my $s = IO::Socket::INET->new(
          PeerAddr => $server,
          Proto    => 'tcp',
      ) or die "[$server] socket connect error: $!";
  
      # auth
      if ($pass) {
          $s->print("AUTH $pass \r\n");
          <$s> || die "[$server] socket auth error: $!";
      }
  
      my $self = bless {
          socket  => $s,
      }, $class;
      $self;
  }
  
  sub info {
      my ($self) = @_;
  
      my $buf = $self->command('INFO');
  
      my $stats = {};
      for my $row (split(/\r\n/, $buf)) {
          next if $row =~ /^#/;
          next if $row =~ /^$/;
          my ($key, $val) = split(/:/, $row);
          $stats->{$key} = $val;
      }
  
      return $stats;
  }
  
  sub config {
      my ($self) = @_;
      return $self->command("CONFIG", "GET", "*");
  }
  
  sub slowlog {
      my ($self) = @_;
      return $self->command("SLOWLOG", "LEN");
  }
  
  sub command {
      my ($self, @command) = @_;
  
      my $s = $self->{socket};
      my $req = $self->request(@command);
  
      $s->send($req);
  
      my $ret = $s->recv( my $buffer, 131072 );
      my @lines = split(/\r\n/, $buffer);
      my $header = $self->row_parser($lines[0]);
      return $buffer if $header->{type} eq 'itemlen';
      return $header->{value} if $header->{type} eq 'number';
  
      my %stats = ();
      my $key;
  
      for my $line (@lines) {
          my $row = $self->row_parser($line);
          if($row->{type} eq 'line') {
              unless($key) {
                  $key = $row->{value};
              } else {
                  $stats{$key} = $row->{value};
                  $key = undef;
              }
          }
      }
  
      return \%stats;
  }
  
  sub row_parser {
      my ($self, $row) = @_;
  
      if($row =~ /^(\*|\$|\:)+(\w+)/) {
          if($1 eq '*') { # header
              return {
                  type  => 'rowlen',
                  value => $2,
              };
          } elsif($1 eq '$') { # next length
              return {
                  type  => 'itemlen',
                  value => $2,
              };
          } elsif($1 eq ':') { # number
              return {
                  type  => 'number',
                  value => $2,
              };
          }
      }
  
      $row =~ s/\r\n//;
      return {
          type  => 'line',
          value => $row,
      }
  }
  
  sub request {
      my ($self, @args) = @_;
  
      my $nl = "\015\012";
      my $req = sprintf('*%d%s', scalar(@args), $nl);
      $req .= sprintf('$%d%s%s%s', length($_), $nl, $_, $nl) for @args;
      return $req;
  }
  
  1;
APP_REDISTOP_REDIS

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
     if (my $fat = $_[0]{$_[1]}) {
       return sub {
         return 0 unless length $fat;
         $fat =~ s/^([^\n]*\n?)//;
         $_ = $1;
         return 1;
       };
     }
     return;
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE

#!perl

use strict;
use warnings;
use IO::Socket;
use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat bundling);
use Pod::Usage qw(pod2usage);

use App::RedisTop::Component::Time;
use App::RedisTop::Component::CPU;
use App::RedisTop::Component::Memory;
use App::RedisTop::Component::MemoryPer;
use App::RedisTop::Component::Connection;
use App::RedisTop::Component::ConnectionPer;
use App::RedisTop::Component::Save;
use App::RedisTop::Component::Command;
use App::RedisTop::Component::Slowlog;
use App::RedisTop::Component::DB;

#################################
# main
#################################
package main;

my %groups = (
    time      => { class => App::RedisTop::Component::Time->new(),          sort => 1, },
    cpu       => { class => App::RedisTop::Component::CPU->new(),           sort => 2, },
    memory    => { class => App::RedisTop::Component::Memory->new(),        sort => 3, },
    memoryper => { class => App::RedisTop::Component::MemoryPer->new(),     sort => 4, },
    conn      => { class => App::RedisTop::Component::Connection->new(),    sort => 5, },
    connper   => { class => App::RedisTop::Component::ConnectionPer->new(), sort => 6, },
    save      => { class => App::RedisTop::Component::Save->new(),          sort => 7, },
    command   => { class => App::RedisTop::Component::Command->new(),       sort => 8, },
    slowlog   => { class => App::RedisTop::Component::Slowlog->new(),       sort => 9, },
    db        => { class => App::RedisTop::Component::DB->new(dbid => 0),   sort => 10, },
);

sub main {
    my $opt = +{};

    GetOptions(
        't|time'        => \$opt->{time},
        'c|cpu'         => \$opt->{cpu},
        'M|memory'      => \$opt->{memory},
        'm|memoryper'   => \$opt->{memoryper},
        'n|conn'        => \$opt->{conn},
        'o|connper'     => \$opt->{connper},
        's|save'        => \$opt->{save},
        'C|command'     => \$opt->{command},
        'l|slowlog'     => \$opt->{slowlog},
        'd|db'          => \$opt->{db},
        'i|instances=s' => \$opt->{instances},
        'sleep=i'       => \$opt->{sleep},
        'nocolor'       => \$opt->{nocolor},
        'h|help'        => \$opt->{help},
    );

    pod2usage 1 if $opt->{help};

    my $sleep     = $opt->{sleep} || 3;
    my @instances = ($opt->{instances}) ? split(/,/, $opt->{instances}) : ('127.0.0.1:6379');
    $ENV{ANSI_COLORS_DISABLED} = 1 if $opt->{nocolor};

    # group specified
    my @sp_groups;
    for my $key (sort{ $groups{$a}->{'sort'} <=> $groups{$b}->{'sort'}} keys %groups) {
        push @sp_groups, $groups{$key}->{class} if $opt->{$key};
    }

    # default
    if(scalar @sp_groups == 0) {
        push @sp_groups, $groups{$_}->{class} for qw/cpu memory conn save command db/;
    }

    my $perform = do {
        if ($0 =~ /-stat/) {
            require App::RedisTop::PerformStat;
            App::RedisTop::PerformStat->new(
                groups    => \@sp_groups,
                instances => \@instances,
            );
        } else {
            require App::RedisTop::Perform;
            App::RedisTop::Perform->new(
                groups    => \@sp_groups,
                instances => \@instances,
            );
        }
    };
    while(1) {
        $perform->run;
        sleep($sleep);
    }
}

main();

__END__

=head1 NAME

redis-top - Redis resource statistics tool.

=head1 DESCRIPTION

Redis resource statistics tool.

=head1 USAGE

redis-top [options]
redis-stat [options]

=head2 Example

=over 4

=item redis-top -i 127.0.0.1:6379,127.0.0.1:6380,127.0.0.1:6381,127.0.0.1:6382

=item redis-top --sleep 1 --nocolor --cpu --memory --db

=item redis-top --cpu --memory --conn --save --command --db  # default

=item redis-top -cMnsCdmolt  # full

=back

=head1 OPTIONS

=head2 GROUP OPTIONS

=over 4

=item -c,--cpu

enable cpu stats

=item -M,--memory

enable memory stats

=item -m,--memoryper

enable used_memory/maxmemory stats

=item -n,--conn

enable connection stats

=item -o,--connper

enable connected_clients/maxclients stats

=item -s,--save

enable save stats

=item -C,--command

enable command stats

=item -l,--slowlog

enable slowlog stats

=item -d,--db

enable db stats (default:db0 stats)

=item -t,--time

enable time output

=back

=head2 GLOBAL OPTIONS

=over 4

=item --sleep

sleep time (default:3)

=item --nocolor

disable colors

=item -h --help

show help

=back

=cut