couchdb-view-server.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 # http://wiki.apache.org/couchdb/View_server
   6 #
   7 # /etc/couchdb/local.ini add:
   8 #
   9 # [query_servers]
  10 # perl = /usr/bin/perl /srv/angular-mojolicious/couchdb-view-server.pl
  11
  12 use JSON::XS;
  13 use IO::Handle;
  14 use Data::Dump qw(dump);
  15
  16 my $j = JSON::XS->new;
  17
  18 my $in  = IO::Handle->new_from_fd(\*STDIN, 'r');
  19 my $out = IO::Handle->new_from_fd(\*STDOUT, 'w');
  20 $out->autoflush(1);
  21
  22 sub _log {
  23         $out->print(qq|["log", "@_"]\n|);
  24         warn "# log @_\n";
  25 }
  26
  27 our $fun;
  28
  29 while(defined(my $line = $in->getline)) {
  30         chomp $line;
  31         my $input = $j->decode($line);
  32         my ($cmd, @args) = @$input;
  33
  34         if ( $cmd eq 'reset' ) {
  35                 undef $fun;
  36                 $out->print("true\n");
  37         } elsif ( $cmd eq 'add_fun' ) {
  38                 $fun = eval @args;
  39                 if ( $@ ) {
  40                         $out->print( qq|{"error": "$!", "reason": "$@"}\n| );
  41                 } else {
  42                         $out->print("true\n");
  43                 }
  44         } elsif ( $cmd eq 'map_doc' ) {
  45                 my @results;
  46                 our @d;
  47                 local @d;
  48                 eval { $fun->(@args) };
  49                 if ( $@ ) {
  50                         _log $@;
  51                 } else {
  52                         push @results, [@d];
  53                 }
  54                 $out->print($j->utf8->encode( \@results ), "\n");
  55         } else {
  56                 die "$cmd unimplemented", dump( $input );
  57         }
  58 }