From: Matt S Trout Date: Mon, 14 Nov 2011 17:51:21 +0000 (+0000) Subject: remove early stage fiddling code X-Git-Tag: v0.001001~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FTak.git;a=commitdiff_plain;h=b1350e7523c0d9c66ee6c677a593c0df92b6b545 remove early stage fiddling code --- diff --git a/jreplclient b/jreplclient deleted file mode 100644 index 82e113b..0000000 --- a/jreplclient +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/env perl - -use strictures 1; -use IPC::Open2; -use Term::ReadLine; -use JSON::PP qw(encode_json decode_json); - -my $cmd = do { - if (my $host = $ARGV[0]) { - 'ssh '.$host.' perl -' - } else { - 'perl -' - } -}; - -my $pid = open2(my $out, my $in, $cmd); - -{ - my $jr; - if (!eof(*DATA)) { - $jr = \*DATA - } else { - open $jr, '<', 'jsonrepl.packed' or die "No packed repl: $!"; - } - while (<$jr>) { print $in $_ } - print $in "__END__\n"; -} - -my $read = Term::ReadLine->new('REPL'); - -while (1) { - my $line = $read->readline('re.pl$ '); - exit unless defined $line; - next unless length $line; - print $in encode_json([ EVAL => $line ])."\n"; - my $reply = decode_json scalar readline($out); - if ($reply->[0] eq 'MISTAKE') { - die "Botch: ".join(': ', @{$reply}[1,2]); - } - my $ret = $reply->[1]; - print $ret->{return}; - if ($ret->{stdout}) { - chomp($ret->{stdout}); - print "STDOUT:\n${\$ret->{stdout}}\n"; - } - if ($ret->{stderr}) { - chomp($ret->{stderr}); - print "STDERR:\n${\$ret->{stderr}}\n"; - } -} diff --git a/jsonrepl b/jsonrepl deleted file mode 100644 index 4151567..0000000 --- a/jsonrepl +++ /dev/null @@ -1,81 +0,0 @@ -#!/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 = ) { - 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"); - } -}