summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2017-12-09 13:54:25 +0100
committerYorhel <git@yorhel.nl>2017-12-09 13:54:25 +0100
commit98e1987906e3bf036f97c54bc10108b7ccf16912 (patch)
tree447b9d136cbc14f63243e1cfcb6fc98136bc5a70
parent66b1bce16cf42461185060f999724b775bb0a2cb (diff)
Add vndb-dev-server.pl, an autoreloading http server
-rw-r--r--README2
-rwxr-xr-xutil/docker-init.sh4
-rwxr-xr-xutil/vndb-dev-server.pl153
-rwxr-xr-xutil/vndb.pl1
4 files changed, 158 insertions, 2 deletions
diff --git a/README b/README
index e44ae07b..af07c0a4 100644
--- a/README
+++ b/README
@@ -94,7 +94,7 @@ Setup
the previous step.
- Now simply run:
- util/vndb.pl
+ util/vndb-dev-server.pl
(Note: At the time of writing, the above command will require the git
version of TUWF installed, but I intent to upload a new version to CPAN
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';