jsonrepl

   1 #!/usr/bin/env perl
   2
   3 use strictures 1;
   4 use JSON::PP qw(encode_json decode_json);
   5 use Eval::WithLexicals;
   6 use Data::Dumper::Concise;
   7 use IO::Handle;
   8
   9 our $DEBUG;
  10
  11 STDOUT->autoflush(1);
  12
  13 my $eval = Eval::WithLexicals->new;
  14
  15 sub out {
  16   warn "sending: ".encode_json([ @_ ])."\n" if $DEBUG;
  17   print STDOUT encode_json([ @_ ])."\n"
  18     or die "Failed to print to STDOUT: $!";
  19 }
  20
  21 sub run_eval {
  22   my ($perl) = @_;
  23   unless ($perl) {
  24     out(MISTAKE => eval_input => "No code supplied");
  25     return;
  26   }
  27   if (my $ref = ref($perl)) {
  28     out(MISTAKE => eval_input => "Code was a ${ref} reference");
  29     return;
  30   }
  31   my ($code, @ret);
  32   open my $stdout, '>', \my $output;
  33   open my $stderr, '>', \my $errors;
  34   if (eval {
  35     local *STDOUT = $stdout;
  36     local *STDERR = $stderr;
  37     @ret = $eval->eval($perl);
  38     1
  39   }) {
  40     $code = 'OK';
  41   } else {
  42     ($code, @ret) = (FAILURE => $@);
  43   }
  44   my $dumped_ret;
  45   unless (eval { $dumped_ret = Dumper(@ret); 1 }) {
  46     $dumped_ret = "Error dumping ${code} result: $@";
  47     $code = 'FAILURE';
  48   }
  49   out($code => { stdout => $output, stderr => $errors, return => $dumped_ret });
  50 }
  51
  52 warn "starting\n" if $DEBUG;
  53
  54 while (my $line = <STDIN>) {
  55   warn "got: $line" if $DEBUG;
  56   my $data = eval { decode_json($line) };
  57   if ($@) {
  58     out(MISTAKE => invalid_json => $@);
  59     next;
  60   }
  61   unless (ref($data) eq 'ARRAY') {
  62     out(MISTAKE => message_format => "Not an ARRAY");
  63     next;
  64   }
  65   unless (@$data > 0) {
  66     out(MISTAKE => message_format => "No message name");
  67     next;
  68   }
  69   if (my $ref = ref($data->[0])) {
  70     out(MISTAKE => message_format => "Message name was a ${ref} ref");
  71     next;
  72   }
  73   my ($message, @args) = @{$data};
  74   if ($message eq 'EXIT') {
  75     exit 0;
  76   } elsif ($message eq 'EVAL') {
  77     run_eval(@args);
  78   } else {
  79     out(MISTAKE => message_name => "Unknown message");
  80   }
  81 }