From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 23 Oct 2011 11:32:06 +0000 (+0000)
Subject: json repl script
X-Git-Tag: v0.001001~41
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=03ae33ef5f8178194331545ad512994f3c8356b4;p=scpubgit%2FTak.git

json repl script
---

03ae33ef5f8178194331545ad512994f3c8356b4
diff --git a/jsonrepl b/jsonrepl
new file mode 100644
index 0000000..321beb0
--- /dev/null
+++ b/jsonrepl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strictures 1;
+use JSON::PP qw(encode_json decode_json);
+use Eval::WithLexicals;
+use Data::Dumper::Concise;
+use IO::Handle;
+
+STDOUT->autoflush(1);
+
+my $eval = Eval::WithLexicals->new;
+
+sub out {
+  print STDOUT encode_json([ @_ ])."\n"
+    or die "Failed to print to STDOUT: $!";
+}
+
+sub run_eval {
+  my ($perl) = @_;
+  unless ($perl) {
+    out(MISTAKE => eval_input => "No code supplied");
+    return;
+  }
+  if (my $ref = ref($perl)) {
+    out(MISTAKE => eval_input => "Code was a ${ref} reference");
+    return;
+  }
+  my ($code, @ret);
+  open my $stdout, '>', \my $output;
+  open my $stderr, '>', \my $errors;
+  if (eval {
+    local *STDOUT = $stdout;
+    local *STDERR = $stderr;
+    @ret = $eval->eval($perl);
+    1
+  }) {
+    $code = 'OK';
+  } else {
+    ($code, @ret) = (FAILURE => $@);
+  }
+  my $dumped_ret;
+  unless (eval { $dumped_ret = Dumper(@ret); 1 }) {
+    $dumped_ret = "Error dumping ${code} result: $@";
+    $code = 'FAILURE';
+  }
+  out($code => { stdout => $output, stderr => $errors, return => $dumped_ret });
+}
+
+while (my $line = <STDIN>) {
+  my $data = eval { decode_json($line) };
+  if ($@) {
+    out(MISTAKE => invalid_json => $@);
+    next;
+  }
+  unless (ref($data) eq 'ARRAY') {
+    out(MISTAKE => message_format => "Not an ARRAY");
+    next;
+  }
+  unless (@$data > 0) {
+    out(MISTAKE => message_format => "No message name");
+    next;
+  }
+  if (my $ref = ref($data->[0])) {
+    out(MISTAKE => message_format => "Message name was a ${ref} ref");
+    next;
+  }
+  my ($message, @args) = @{$data};
+  if ($message eq 'EXIT') {
+    exit 0;
+  } elsif ($message eq 'EVAL') {
+    run_eval(@args);
+  } else {
+    out(MISTAKE => message_name => "Unknown message");
+  }
+}