We do not use the POSIX module.
[remoteglot] / www / analysis.pl
1 #! /usr/bin/perl
2 use CGI;
3 use Linux::Inotify2;
4 use AnyEvent;
5 use strict;
6 use warnings;
7
8 our $json_filename = "/srv/analysis.sesse.net/www/analysis.json";
9
10 my $cv = AnyEvent->condvar;
11 my $updated = 0;
12 my $cgi = CGI->new;
13 my $inotify = Linux::Inotify2->new;
14 $inotify->watch($json_filename, IN_MODIFY, sub {
15         $updated = 1;
16         $cv->send;
17 });
18         
19 my $inotify_w = AnyEvent->io (
20         fh => $inotify->fileno, poll => 'r', cb => sub { $inotify->poll }
21 );
22 my $wait = AnyEvent->timer (
23         after => 30,
24         cb    => sub { $cv->send; },
25 );
26
27 # Yes, this is reinventing If-Modified-Since, but browsers are so incredibly
28 # unpredictable on this, so blargh.
29 my $ims = 0;
30 if (defined($cgi->param('ims')) && $cgi->param('ims') ne '') {
31         $ims = $cgi->param('ims');
32 }
33 my $time = (stat($json_filename))[9];
34
35 # If we have something that's modified since IMS, send it out at once
36 if ($time > $ims) {
37         output();
38         exit;
39 }
40
41 # If not, wait, then send.
42 $cv->recv;
43 output();
44
45 sub output {
46         open my $fh, "<", $json_filename
47                 or die "$json_filename: $!";
48         my $data;
49         {
50                 local $/ = undef;
51                 $data = <$fh>;
52         }
53         my $time = (stat($fh))[9];
54         close $fh;
55
56         print CGI->header(-type=>'text/json',
57                           -x_remoteglot_last_modified=>$time,
58                           -access_control_allow_origin=>'http://analysis.sesse.net',
59                           -access_control_expose_headers=>'X-Remoteglot-Last-Modified',
60                           -expires=>'now');
61         print $data;
62 }