From 98e1987906e3bf036f97c54bc10108b7ccf16912 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Sat, 9 Dec 2017 13:54:25 +0100
Subject: Add vndb-dev-server.pl, an autoreloading http server

---
 util/docker-init.sh     |   4 +-
 util/vndb-dev-server.pl | 153 ++++++++++++++++++++++++++++++++++++++++++++++++
 util/vndb.pl            |   1 +
 3 files changed, 157 insertions(+), 1 deletion(-)
 create mode 100755 util/vndb-dev-server.pl

(limited to 'util')

diff --git a/util/docker-init.sh b/util/docker-init.sh
index dce2339c..f815c7f8 100755
--- a/util/docker-init.sh
+++ b/util/docker-init.sh
@@ -35,9 +35,11 @@ pg_start() {
 
 pg_init() {
     if test -f /var/lib/postgresql/vndb-init-done; then
+        echo
         echo "Database initialization already done."
         echo "Run the following as root to bypass this check:"
         echo "  rm /var/lib/postgresql/vndb-init-done"
+        echo
         return
     fi
     su postgres -c '/var/www/util/docker-init.sh pg_load_superuser'
@@ -63,7 +65,7 @@ pg_load_vndb() {
 # Should run as devuser
 devshell() {
     cd /var/www
-    make && util/vndb.pl
+    util/vndb-dev-server.pl
     bash
 }
 
diff --git a/util/vndb-dev-server.pl b/util/vndb-dev-server.pl
new file mode 100755
index 00000000..c2cf5103
--- /dev/null
+++ b/util/vndb-dev-server.pl
@@ -0,0 +1,153 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use AE;
+use AnyEvent::Util;
+use AnyEvent::Socket;
+use AnyEvent::Handle;
+use File::Find;
+use Time::HiRes 'time';
+
+use Cwd 'abs_path';
+(my $ROOT = abs_path $0) =~ s{/util/vndb-dev-server\.pl$}{};
+
+my $listen_port = $ENV{TUWF_HTTP_SERVER_PORT} || 3000;
+$ENV{TUWF_HTTP_SERVER_PORT} = $listen_port+1;
+
+my($pid, $prog, $killed);
+
+sub prog_start {
+    $killed = AE::cv;
+    my $started = AE::cv;
+    my $output = sub {
+        my $d = shift || return;
+        if($started && $d =~ /^TUWF::http: You can connect to your server at/) {
+            $started->send;
+            return;
+        }
+        print $d;
+    };
+    $prog = run_cmd "$ROOT/util/vndb.pl",
+        '$$' => \$pid,
+        '>'  => $output,
+        '2>' => $output;
+    $prog->cb(sub {
+        $started->send if $started;
+        $killed->send;
+        $prog = undef;
+        $pid = undef;
+    });
+    $started->recv;
+}
+
+sub prog_stop {
+    kill 'TERM', $pid if $pid;
+    $killed->recv if $killed;
+    $prog = undef;
+    $pid = undef;
+    $killed = undef;
+}
+
+
+sub make_run {
+    my $cb = run_cmd "make -C $ROOT",
+        '>', sub {
+            my $d = shift||'';
+            return if $d =~ /(Entering|Leaving) directory '\Q$ROOT\E'/;
+            return if $d =~ /Nothing to be done for 'all'/;
+            print $d;
+        };
+    $cb->recv;
+}
+
+
+sub pipe_fhs {
+    my($a_fh, $b_fh) = @_;
+    my($a, $b);
+    my $done = AE::cv;
+    $done->begin;
+    $a = AnyEvent::Handle->new(
+        fh => $a_fh,
+        on_read => sub { $b->push_write($a->{rbuf}); $a->{rbuf} = '' },
+        on_error => sub { $done->end if $_[1] },
+    );
+    $done->begin;
+    $b = AnyEvent::Handle->new(
+        fh => $b_fh,
+        on_read => sub { $a->push_write($b->{rbuf}); $b->{rbuf} = '' },
+        on_error => sub { $done->end if $_[1] },
+    );
+    $done->recv;
+}
+
+
+END { prog_stop; }
+
+
+my $lastmod = time;
+sub checkmod {
+    my $newlastmod = 0;
+    my $check = sub {
+        my $mtime = (stat($_[0]))[9];
+        $newlastmod = $mtime if $mtime > $newlastmod;
+    };
+
+    find sub {
+        $check->($_) if /\.pm$/ && $_ ne 'Multi';
+    }, "$ROOT/lib";
+
+    chdir $ROOT;
+    $check->($_) for (qw{
+        util/vndb.pl
+        data/config.pl
+        data/global.pl
+    });
+
+    my $ismod = $newlastmod > $lastmod;
+    $lastmod = $newlastmod;
+    return $ismod;
+}
+
+
+my $conn = AE::cv;
+my @conn;
+tcp_server undef, $listen_port,
+    sub { push @conn, shift; $conn->send },
+    sub {
+        print "VNDB development server running at http://localhost:$listen_port/\n";
+        print "\n";
+        print "This server will automatically regenerate static assets and\n";
+        print "reload itself whenever the VNDB source code has been edited.\n";
+        print "Errors and debugging information will be shown in this console.\n";
+        print "\n";
+    };
+
+
+my $needcheck = 0;
+
+while(1) {
+    $conn->recv;
+    my $serv_fh = shift @conn;
+    $conn = AE::cv if !@conn;
+
+    # Only check for modifications at most once every 2 seconds, so that assets
+    # beloning to the same page view don't cause expensive checks and reloads.
+    if($needcheck+2 < time) {
+        make_run;
+        if(checkmod) {
+            print "File has been modified, restarting server.\n";
+            prog_stop;
+            prog_start;
+        } elsif(!$prog) {
+            prog_start;
+        }
+        $needcheck = time;
+    }
+    next if !$prog;
+
+    my $prog_conn = AE::cv;
+    tcp_connect '127.0.0.1', $ENV{TUWF_HTTP_SERVER_PORT}, sub { $prog_conn->send(shift); };
+    my $prog_fh = $prog_conn->recv || die "Unable to connect to vndb.pl? $!";
+    pipe_fhs($serv_fh, $prog_fh);
+}
diff --git a/util/vndb.pl b/util/vndb.pl
index 46ff9e0d..c0af72e1 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -11,6 +11,7 @@ use Cwd 'abs_path';
 our $ROOT;
 BEGIN { ($ROOT = abs_path $0) =~ s{/util/vndb\.pl$}{}; }
 
+$|=1; # Disable buffering on STDOUT, otherwise vndb-dev-server.pl won't pick up our readyness notification.
 
 use lib $ROOT.'/lib';
 
-- 
cgit v1.2.3