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 use JSON::XS;
   8 use IO::Handle;
   9 use Data::Dump qw(dump);
  10
  11 my $j = JSON::XS->new;
  12
  13 my $in  = IO::Handle->new_from_fd(\*STDIN, 'r');
  14 my $out = IO::Handle->new_from_fd(\*STDOUT, 'w');
  15 $out->autoflush(1);
  16
  17 sub _log {
  18         $out->print(qq|["log", "@_"]\n|);
  19         warn "# log @_\n";
  20 }
  21
  22 our $fun;
  23
  24 while(defined(my $line = $in->getline)) {
  25         chomp $line;
  26         my $input = $j->decode($line);
  27         my ($cmd, @args) = @$input;
  28
  29         if ( $cmd eq 'reset' ) {
  30                 undef $fun;
  31                 $out->print("true\n");
  32         } elsif ( $cmd eq 'add_fun' ) {
  33                 $fun = eval @args;
  34                 if ( $@ ) {
  35                         $out->print( qq|{"error": "$!", "reason": "$@"}\n| );
  36                 } else {
  37                         $out->print("true\n");
  38                 }
  39         } elsif ( $cmd eq 'map_doc' ) {
  40                 my @results;
  41                 our @d;
  42                 local @d;
  43                 eval { $fun->(@args) };
  44                 if ( $@ ) {
  45                         _log $@;
  46                 } else {
  47                         push @results, [@d];
  48                 }
  49                 $out->print($j->utf8->encode( \@results ), "\n");
  50         } else {
  51                 die "$cmd unimplemented", dump( $input );
  52         }
  53 }