From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Fri, 14 Oct 2011 17:58:06 +0000 (+0200)
Subject: initial implementation of CouchDB View server in perl
X-Git-Url: http://git.rot13.org/?p=angular-mojolicious.git;a=commitdiff_plain;h=a54f912406c5c8b939bcbf83a30402678beca0f2

initial implementation of CouchDB View server in perl
---

diff --git a/couchdb-view-server.pl b/couchdb-view-server.pl
new file mode 100755
index 0000000..a8827b3
--- /dev/null
+++ b/couchdb-view-server.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# http://wiki.apache.org/couchdb/View_server
+
+use JSON::XS;
+use IO::Handle;
+use Data::Dump qw(dump);
+
+my $j = JSON::XS->new;
+
+my $in  = IO::Handle->new_from_fd(\*STDIN, 'r');
+my $out = IO::Handle->new_from_fd(\*STDOUT, 'w');
+$out->autoflush(1);
+
+sub _log {
+	$out->print(qq|["log", "@_"]\n|);
+	warn "# log @_\n";
+}
+
+our $fun;
+
+while(defined(my $line = $in->getline)) {
+	chomp $line;
+	my $input = $j->decode($line);
+	my ($cmd, @args) = @$input;
+
+	if ( $cmd eq 'reset' ) {
+		undef $fun;
+		$out->print("true\n");
+	} elsif ( $cmd eq 'add_fun' ) {
+		$fun = eval @args;
+		if ( $@ ) {
+			$out->print( qq|{"error": "$!", "reason": "$@"}\n| );
+		} else {
+			$out->print("true\n");
+		}
+	} elsif ( $cmd eq 'map_doc' ) {
+		my @results;
+		our @d;
+		local @d;
+		eval { $fun->(@args) };
+		if ( $@ ) {
+			_log $@;
+		} else {
+			push @results, [@d];
+		}
+		$out->print($j->utf8->encode( \@results ), "\n");
+	} else {
+		die "$cmd unimplemented", dump( $input );
+	}
+}