git.sesse.net Git - remoteglot/blob - 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 }