json repl script

[scpubgit/Tak.git] / jsonrepl

#!/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");
  }
}