PageRenderTime 39ms CodeModel.GetById 13ms app.highlight 23ms RepoModel.GetById 1ms app.codeStats 0ms

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