Added daily-generated JSON dump of the tag information

This isn't documented yet.

5 files changed, 85 insertions, 2 deletions

diff --git a/.gitignore b/.gitignore
index 0a0a346b..f2076aaf 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,4 +11,5 @@
 /static/sf/
 /static/st/
 /static/robots.txt
+/static/api
 /www/
diff --git a/Makefile b/Makefile
index e03ee3c7..fbb866fc 100644
--- a/Makefile
+++ b/Makefile
@@ -43,7 +43,7 @@
 
 all: dirs js skins robots data/config.pl
 
-dirs: static/f/js static/ch static/cv static/sf static/st data/log www www/feeds
+dirs: static/api static/f/js static/ch static/cv static/sf static/st data/log www www/feeds
 
 js: static/f/js/en.js
 
@@ -55,7 +55,7 @@ static/ch static/cv static/sf static/st:
 	mkdir $@;
 	for i in $$(seq -w 0 1 99); do mkdir "$@/$$i"; done
 
-static/f/js data/log www www/feeds:
+static/api static/f/js data/log www www/feeds:
 	mkdir $@
 
 static/f/js/en.js: data/script.js data/lang.txt util/jsgen.pl data/config.pl data/global.pl
diff --git a/README b/README
index 3eaef0fb..c7d011c5 100644
--- a/README
+++ b/README
@@ -34,6 +34,9 @@ Requirements
   util/multi.pl:
     API:
       JSON::XS
+    APIDump:
+      JSON::XS
+      PerlIO::gzip
     Core:
       DBI
       DBD::Pg
diff --git a/data/global.pl b/data/global.pl
index abd33d1e..5ac491d0 100644
--- a/data/global.pl
+++ b/data/global.pl
@@ -116,6 +116,7 @@ our %M = (
   log_dir   => $ROOT.'/data/log',
   modules   => {
     #API         => {},  # disabled by default, not really needed
+    #APIDump     => {},
     Feed        => {},
     RG          => {},
     Image       => {},
diff --git a/lib/Multi/APIDump.pm b/lib/Multi/APIDump.pm
new file mode 100644
index 00000000..c61304b6
--- /dev/null
+++ b/lib/Multi/APIDump.pm
@@ -0,0 +1,78 @@
+
+#
+#  Multi::APIDump  -  Regular dumps of the database for public API stuff
+#
+
+package Multi::APIDump;
+
+use strict;
+use warnings;
+use POE;
+use JSON::XS;
+use PerlIO::gzip;
+use Time::HiRes 'time';
+
+
+sub spawn {
+  my $p = shift;
+  POE::Session->create(
+    package_states => [
+      $p => [qw| _start shutdown generate tags_write |],
+    ],
+    heap => {
+      regenerate_interval => 86400, # daily min.
+      tagsfile => "$VNDB::ROOT/static/api/tags.json.gz",
+      @_,
+    },
+  );
+}
+
+
+sub _start {
+  $_[KERNEL]->alias_set('apidump');
+  $_[KERNEL]->yield('generate');
+  $_[KERNEL]->sig(shutdown => 'shutdown');
+}
+
+
+sub shutdown {
+  $_[KERNEL]->delay('generate');
+  $_[KERNEL]->alias_remove('apidump');
+}
+
+
+sub generate {
+  $_[KERNEL]->alarm(generate => int((time+3)/$_[HEAP]{regenerate_interval}+1)*$_[HEAP]{regenerate_interval});
+
+  # The subqueries are kinda ugly, but it's convenient to have everything in a single query.
+  $_[KERNEL]->post(pg => query => q{
+    SELECT id, name, description, meta, c_items AS vns, cat,
+      (SELECT string_agg(alias,'$$$-$$$') FROM tags_aliases where tag = id) AS aliases,
+      (SELECT string_agg(parent::text, ',') FROM tags_parents WHERE tag = id) AS parents
+    FROM tags WHERE state = 2
+  }, undef, 'tags_write');
+}
+
+
+sub tags_write {
+  my($res, $time) = @_[ARG1,ARG3];
+  my $ws = time;
+
+  for(@$res) {
+    $_->{id} *= 1;
+    $_->{meta} = $_->{meta} ? JSON::XS::true : JSON::XS::false;
+    $_->{aliases} = [ split /\$\$\$-\$\$\$/, ($_->{aliases}||'') ];
+    $_->{parents} = [ map $_*1, split /,/, ($_->{parents}||'') ];
+  }
+
+  open my $f, '>:gzip:utf8', "$_[HEAP]{tagsfile}~" or die $!;
+  print $f JSON::XS->new->encode($res);
+  close $f;
+  rename "$_[HEAP]{tagsfile}~", $_[HEAP]{tagsfile} or die $!;
+
+  my $wt = time-$ws;
+  $_[KERNEL]->call(core => log => 'Wrote %s in %.2fs query + %.2fs write, size: %.1fkB, tags: %d.',
+    $_[HEAP]{tagsfile}, $time, $wt, (-s $_[HEAP]{tagsfile})/1024, scalar @$res);
+}
+
+1;