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