+++ /dev/null
-#!/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;
-
-our $DEBUG;
-
-STDOUT->autoflush(1);
-
-my $eval = Eval::WithLexicals->new;
-
-sub out {
- warn "sending: ".encode_json([ @_ ])."\n" if $DEBUG;
- 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 });
-}
-
-warn "starting\n" if $DEBUG;
-
-while (my $line = <STDIN>) {
- warn "got: $line" if $DEBUG;
- 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");
- }
-}