Fix an issue where switching backends would cause the gong to go off.
[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 my $url = $ARGV[0] // "/analysis.pl";  # Technically an URL regex, not an URL.
12 my $port = $ARGV[1] // 5000;
13
14 open my $fh, "-|", "varnishncsa -F '%{%s}t %U %q tffb=%{Varnish:time_firstbyte}x' -q 'ReqURL ~ \"^$url\"'"
15         or die "varnishncsa: $!";
16 my %uniques = ();
17
18 my $ev = AnyEvent::Handle->new(
19         fh => $fh,
20         on_read => sub {
21                 my ($hdl) = @_;
22                 $hdl->push_read(
23                         line => sub {
24                                 my ($hdl, $line, $eof) = @_;
25                                 handle_line($line);
26                         }
27                 );
28         },
29 );
30 my $ev2 = AnyEvent->timer(
31         interval => 1.0,
32         cb => \&output
33 );
34 EV::run;
35
36 sub handle_line {
37         my $line = shift;
38         $line =~ m#(\d+) /analysis.pl \?ims=\d+&unique=(.*) tffb=(.*)# or return;
39         $uniques{$2} = {
40                 last_seen => $1 + $3,
41                 grace => undef,
42         };
43         my $now = time;
44         print "[$now] $1 $2 $3\n";
45 }
46
47 sub output {
48         my $mtime = (stat($remoteglotconf::json_output))[9] - 1;  # Compensate for subsecond issues.
49         my $now = time;
50
51         while (my ($unique, $hash) = each %uniques) {
52                 my $last_seen = $hash->{'last_seen'};
53                 if ($now - $last_seen <= 5) {
54                         # We've seen this user in the last five seconds;
55                         # it's okay.
56                         next;
57                 }
58                 if ($last_seen >= $mtime) {
59                         # This user has the latest version;
60                         # they are probably just hanging.
61                         next;
62                 }
63                 if (!defined($hash->{'grace'})) {
64                         # They have five seconds after a new JSON has been
65                         # provided to get get it, or they're out.
66                         # We don't simply use $mtime, since we don't want to
67                         # reset the grace timer just because a new JSON is
68                         # published.
69                         $hash->{'grace'} = $mtime;
70                 }
71                 if ($now - $hash->{'grace'} > 5) {
72                         printf "Timing out %s (last_seen=%d, now=%d, mtime=%d, grace=%d)\n",
73                                 $unique, $last_seen, $now, $mtime, $hash->{'grace'};
74                         delete $uniques{$unique};
75                 }
76         }
77
78         my $num_viewers = scalar keys %uniques; 
79         printf "%d entries in hash, mtime=$mtime\n", scalar keys %uniques;
80         LWP::Simple::get('http://127.0.0.1:' . $port . '/override-num-viewers?num=' . $num_viewers);    
81 }