Fix a display bug on empty PV.
[remoteglot] / varnishcount.pl
1 #! /usr/bin/perl
2 use Time::HiRes;
3 use LWP::Simple;
4 require 'config.pm';
5 use strict;
6 use warnings;
7 no warnings qw(once);
8
9 $SIG{ALRM} = sub { output(); };
10 Time::HiRes::alarm(1.0, 1.0);
11
12 open my $fh, "-|", "varnishncsa -F '%{%s}t %U %q tffb=%{Varnish:time_firstbyte}x' -q 'ReqURL ~ \"^/analysis.pl\"'"
13         or die "varnishncsa: $!";
14 my %uniques = ();
15
16 while (<$fh>) {
17         chomp;
18         m#(\d+) /analysis.pl \?ims=\d+&unique=(.*) tffb=(.*)# or next;
19         $uniques{$2} = {
20                 last_seen => $1 + $3,
21                 grace => undef,
22         };
23         my $now = time;
24         print "[$now] $1 $2 $3\n";
25 }
26
27 sub output {
28         my $mtime = (stat($remoteglotconf::json_output))[9] - 1;  # Compensate for subsecond issues.
29         my $now = time;
30
31         while (my ($unique, $hash) = each %uniques) {
32                 my $last_seen = $hash->{'last_seen'};
33                 if ($now - $last_seen <= 5) {
34                         # We've seen this user in the last five seconds;
35                         # it's okay.
36                         next;
37                 }
38                 if ($last_seen >= $mtime) {
39                         # This user has the latest version;
40                         # they are probably just hanging.
41                         next;
42                 }
43                 if (!defined($hash->{'grace'})) {
44                         # They have five seconds after a new JSON has been
45                         # provided to get get it, or they're out.
46                         # We don't simply use $mtime, since we don't want to
47                         # reset the grace timer just because a new JSON is
48                         # published.
49                         $hash->{'grace'} = $mtime;
50                 }
51                 if ($now - $hash->{'grace'} > 5) {
52                         printf "Timing out %s (last_seen=%d, now=%d, mtime=%d, grace=%d)\n",
53                                 $unique, $last_seen, $now, $mtime, $hash->{'grace'};
54                         delete $uniques{$unique};
55                 }
56         }
57
58         my $num_viewers = scalar keys %uniques; 
59         printf "%d entries in hash, mtime=$mtime\n", scalar keys %uniques;
60         LWP::Simple::get('http://127.0.0.1:5000/override-num-viewers?num=' . $num_viewers);     
61 }