/lib/Perlbal/Plugin/Stats.pm

http://github.com/perlbal/Perlbal · Perl · 167 lines · 106 code · 34 blank · 27 comment · 5 complexity · 210f6a2faae53367756ffb80509e4774 MD5 · raw file

  1. ###########################################################################
  2. # basic Perlbal statistics gatherer
  3. ###########################################################################
  4. package Perlbal::Plugin::Stats;
  5. use strict;
  6. use warnings;
  7. no warnings qw(deprecated);
  8. use Time::HiRes qw(gettimeofday tv_interval);
  9. # setup our package variables
  10. our %statobjs; # { svc_name => [ service, statobj ], svc_name => [ service, statobj ], ... }
  11. # define all stats keys here
  12. our @statkeys = qw( files_sent files_reproxied
  13. web_requests proxy_requests
  14. proxy_requests_highpri );
  15. # called when we're being added to a service
  16. sub register {
  17. my ($class, $svc) = @_;
  18. # create a stats object
  19. my $sobj = Perlbal::Plugin::Stats::Storage->new();
  20. $statobjs{$svc->{name}} = [ $svc, $sobj ];
  21. # simple events we count are done here. when the hook on the left side is called,
  22. # we simply increment the count of the stat on the right side.
  23. my %simple = qw(
  24. start_send_file files_sent
  25. start_file_reproxy files_reproxied
  26. start_web_request web_requests
  27. );
  28. # create hooks for %simple things
  29. while (my ($hook, $stat) = each %simple) {
  30. eval "\$svc->register_hook('Stats', '$hook', sub { \$sobj->{'$stat'}++; return 0; });";
  31. return undef if $@;
  32. }
  33. # more complicated statistics
  34. $svc->register_hook('Stats', 'backend_client_assigned', sub {
  35. my Perlbal::BackendHTTP $be = shift;
  36. my Perlbal::ClientProxy $cp = $be->{client};
  37. $sobj->{pending}->{"$cp"} = [ gettimeofday() ];
  38. ($cp->{high_priority} ? $sobj->{proxy_requests_highpri} : $sobj->{proxy_requests})++;
  39. return 0;
  40. });
  41. $svc->register_hook('Stats', 'backend_response_received', sub {
  42. my Perlbal::BackendHTTP $be = shift;
  43. my Perlbal::ClientProxy $obj = $be->{client};
  44. my $ot = delete $sobj->{pending}->{"$obj"};
  45. return 0 unless defined $ot;
  46. # now construct data to put in recent
  47. if (defined $obj->{req_headers}) {
  48. my $uri = 'http://' . ($obj->{req_headers}->header('Host') || 'unknown') . $obj->{req_headers}->request_uri;
  49. push @{$sobj->{recent}}, sprintf('%-6.4f %s', tv_interval($ot), $uri);
  50. shift(@{$sobj->{recent}}) if scalar(@{$sobj->{recent}}) > 100; # if > 100 items, lose one
  51. }
  52. return 0;
  53. });
  54. return 1;
  55. }
  56. # called when we're no longer active on a service
  57. sub unregister {
  58. my ($class, $svc) = @_;
  59. # clean up time
  60. $svc->unregister_hooks('Stats');
  61. delete $statobjs{$svc->{name}};
  62. return 1;
  63. }
  64. # called when we are loaded
  65. sub load {
  66. # setup a management command to dump statistics
  67. Perlbal::register_global_hook("manage_command.stats", sub {
  68. my @res;
  69. # create temporary object for stats storage
  70. my $gsobj = Perlbal::Plugin::Stats::Storage->new();
  71. # dump per service
  72. foreach my $svc (keys %statobjs) {
  73. my $sobj = $statobjs{$svc}->[1];
  74. # for now, simply dump the numbers we have
  75. foreach my $key (sort @statkeys) {
  76. push @res, sprintf("%-15s %-25s %12d", $svc, $key, $sobj->{$key});
  77. $gsobj->{$key} += $sobj->{$key};
  78. }
  79. }
  80. # global stats
  81. foreach my $key (sort @statkeys) {
  82. push @res, sprintf("%-15s %-25s %12d", 'total', $key, $gsobj->{$key});
  83. }
  84. push @res, ".";
  85. return \@res;
  86. });
  87. # recent requests and how long they took
  88. Perlbal::register_global_hook("manage_command.recent", sub {
  89. my @res;
  90. foreach my $svc (keys %statobjs) {
  91. my $sobj = $statobjs{$svc}->[1];
  92. push @res, "$svc $_"
  93. foreach @{$sobj->{recent}};
  94. }
  95. push @res, ".";
  96. return \@res;
  97. });
  98. return 1;
  99. }
  100. # called for a global unload
  101. sub unload {
  102. # unregister our global hooks
  103. Perlbal::unregister_global_hook('manage_command.stats');
  104. Perlbal::unregister_global_hook('manage_command.recent');
  105. # take out all service stuff
  106. foreach my $statref (values %statobjs) {
  107. $statref->[0]->unregister_hooks('Stats');
  108. }
  109. %statobjs = ();
  110. return 1;
  111. }
  112. # statistics storage object
  113. package Perlbal::Plugin::Stats::Storage;
  114. use fields (
  115. 'files_sent', # files sent from disk (includes reproxies and regular web requests)
  116. 'files_reproxied', # files we've sent via reproxying (told to by backend)
  117. 'web_requests', # requests we sent ourselves (no reproxy, no backend)
  118. 'proxy_requests', # regular requests that went to a backend to be served
  119. 'proxy_requests_highpri', # same as above, except high priority
  120. 'pending', # hashref; { "obj" => time_start }
  121. 'recent', # arrayref; strings of recent URIs and times
  122. );
  123. sub new {
  124. my Perlbal::Plugin::Stats::Storage $self = shift;
  125. $self = fields::new($self) unless ref $self;
  126. # 0 initialize everything here
  127. $self->{$_} = 0 foreach @Perlbal::Plugin::Stats::statkeys;
  128. # other setup
  129. $self->{pending} = {};
  130. $self->{recent} = [];
  131. return $self;
  132. }
  133. 1;