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