lib/App/Clifton/ConsoleService/Session.pm

   1 package App::Clifton::ConsoleService::Session;
   2
   3 use Eval::WithLexicals;
   4 use Data::Dumper::Concise;
   5 use Moo;
   6
   7 extends 'IO::Async::Protocol::LineStream';
   8
   9 has lex_env => (is => 'lazy');
  10
  11 sub _build_lex_env { Eval::WithLexicals->new }
  12
  13 sub on_read_line {
  14   my ($self, $line) = @_;
  15   my ($cmd, $body) = split(/ /, $line, 2);
  16   if ($cmd !~ /^([A-Z]+)$/) {
  17     $self->_send_response(ERROR => "Invalid command ${cmd}");
  18   } elsif (my $call = $self->can(lc "handle_${cmd}")) {
  19     $self->$call($body ? eval $body : ());
  20   } else {
  21     $self->_send_response(ERROR => "Unknown command ${cmd}");
  22   }
  23 }
  24
  25 sub _send_response {
  26   my ($self, $code, $body) = @_;
  27
  28   if (my $ref = ref($body)) {
  29     ($code, $body) = (ERROR => "Command returned body of reftype ${ref}");
  30   }
  31   if ($code !~ /^([A-Z]+)$/) {
  32     ($code, $body) = (ERROR => "Command returned malformed code ${code}");
  33   }
  34
  35   chomp(my $enc_body = Dumper $body);
  36
  37   $self->write_line(join ' ', $code, $enc_body);
  38 }
  39
  40 sub handle_echo {
  41   my ($self, $body) = @_;
  42   $self->_send_response(ECHO => $body);
  43 }
  44
  45 sub handle_eval {
  46   my ($self, $body) = @_;
  47   return $self->_send_response(ERROR => 'You asked me to eval undef!')
  48     unless defined $body;
  49   if (my $ref = ref $body) {
  50     return $self->_send_response(
  51       ERROR => "You asked me to eval a ${ref} ref"
  52     );
  53   }
  54   my $eval = $self->lex_env;
  55   my $code = 'RESULT';
  56   my @ret; local $@; eval {
  57     @ret = $eval->eval($body); 1;
  58   } or ($code, @ret) = (ERROR => $@);
  59   $self->_send_response(
  60     $code => ($code eq 'RESULT'
  61                 ? do { local $Data::Dumper::Maxdepth = 1; Dumper @ret }
  62                 : $ret[0]
  63              )
  64   );
  65 }
  66
  67 sub on_closed {
  68   my ($self) = @_;
  69   $self->parent->remove_child($self);
  70 }
  71
  72 1;