Slow.pm

###########################################################################
# Slow Perlbal statistics gatherer
#  - based on Perlbal's Stats module
###########################################################################

package Perlbal::Plugin::Slow;

use strict;
use warnings;
no  warnings qw(deprecated);

use Time::HiRes qw(gettimeofday tv_interval);

# setup our package variables
our %statobjs; # { svc_name => [ service, statobj ], svc_name => [ service, statobj ], ... }

# keys associated with a log
our @logkeys = qw( slow warn exceptions );

# define all stats keys here
our @statkeys = (qw( good requests milliseconds ), @logkeys);

# global response time buckets
our $slow = 0.50;
our $warn =  1.00;

# called when we're being added to a service
sub register {
  my ($class, $svc) = @_;

  # create a stats object
  my $sobj = Perlbal::Plugin::Slow::Storage->new();
  $statobjs{$svc->{name}} = [ $svc, $sobj ];

  $svc->register_hook('Slow', 'backend_client_assigned', sub {
                        my Perlbal::BackendHTTP $be = shift;
                        my Perlbal::ClientProxy $cp = $be->{client};
                        $sobj->{pending}->{"$cp"} = [ gettimeofday() ];
                        return 0;
                      });

  $svc->register_hook('Slow', 'backend_response_received', sub {
                        my Perlbal::BackendHTTP $be = shift;
                        my Perlbal::ClientProxy $obj = $be->{client};
                        my $ot = delete $sobj->{pending}->{"$obj"};
                        return 0 unless defined $ot;

                        my $http_status_code = $be->{res_headers}->response_code + 0;
                        my $uri = 'http://' . ($obj->{req_headers}->header('Host') || 'unknown') . $obj->{req_headers}->request_uri;
                        my $duration = tv_interval($ot);
                        my $time = POSIX::strftime("%H:%M:%S", localtime());
                        my $appserver = $be->{ipport};

                        $sobj->{milliseconds} += int($duration*1000);

                        if ($http_status_code < 400) {
                          if ($duration <= $slow) {
                            $sobj->{good}++;
                          }
                          elsif ($duration <= $warn) {
                            $sobj->log_event("slow", $time, $duration, $uri, $appserver);
                          }
                          else {
                            $sobj->log_event("warn", $time, $duration, $uri, $appserver);
                          }
                        }
                        elsif ($http_status_code >= 500) {
                          $sobj->log_event("exceptions", $time, $duration, $uri, $appserver);
                        }

                        $sobj->{requests}++;
                        return 0;
                      });

  return 1;
}

# called when we're no longer active on a service
sub unregister {
  my ($class, $svc) = @_;

  # clean up time
  $svc->unregister_hooks('Slow');
  delete $statobjs{$svc->{name}};
  return 1;
}

# called when we are loaded
sub load {
  # setup a management command to dump statistics
  Perlbal::register_global_hook("manage_command.buckets", sub {
                                  my @res;

                                  foreach my $svc (keys %statobjs) {
                                    my $sobj = $statobjs{$svc}->[1];
                                    foreach my $key (sort @statkeys) {
                                      push @res, sprintf("%-15s %-25s %12d", $svc, $key, $sobj->{$key});
                                    }
                                  }
                                  push @res, ".";
                                  return \@res;
                                });

  # logs hooks
  Perlbal::register_global_hook(make_hook($_)) foreach (@logkeys);

  return 1;
}

# called for a global unload
sub unload {
  # unregister our global hooks
  Perlbal::unregister_global_hook('manage_command.buckets');
  Perlbal::unregister_global_hook(make_hook_name($_)) foreach(@logkeys);

  # take out all service stuff
  foreach my $statref (values %statobjs) {
    $statref->[0]->unregister_hooks('Slow');
  }
  %statobjs = ();

  return 1;
}

sub make_hook_name {
  my $key = shift;
  return "manage_command." . $key;
}

sub make_hook {
  my $key = shift;
  my $logkey = $key . "_log";

  my $handler = sub {
    my @res;
    foreach my $svc (keys %statobjs) {
      my $sobj = $statobjs{$svc}->[1];
      push @res, "$svc $_"
        foreach @{$sobj->{$logkey}};
    }

    push @res, ".";
    return \@res;
  };

  return (make_hook_name($key), $handler);
}

# statistics storage object
package Perlbal::Plugin::Slow::Storage;

use fields (
            'good',
            'slow',
            'warn',
            'exceptions',
            'requests',
            'milliseconds',
            'pending',            # hashref; { "obj" => time_start }
            'slow_log',      # arrayref; strings of recent URIs and times
            'warn_log',    # arrayref; strings of recent URIs and times
            'exceptions_log',      # arrayref; strings of recent URIs and times
           );

sub new {
  my Perlbal::Plugin::Slow::Storage $self = shift;
  $self = fields::new($self) unless ref $self;

  # 0 initialize everything here
  $self->{$_} = 0 foreach @Perlbal::Plugin::Slow::statkeys;

  # other setup
  $self->{pending} = {};
  $self->{exceptions_log} = [];
  $self->{slow_log} = [];
  $self->{warn_log} = [];

  return $self;
}

sub log_event {
  my ($self, $key, $time, $duration, $uri, $appserver) = @_;
  my $logkey = $key . "_log";
  $self->{$key}++;
  push @{$self->{$logkey}}, sprintf('%s %s %-6.4f %s', $time, $appserver, $duration, $uri);
  shift(@{$self->{$logkey}}) if scalar(@{$self->{$logkey}}) > 100; # if > 100 items, lose one
}

1;