Make web parts use new async code for pastebin. API is broken.

lib/App/Controller/Eval.pm

@@ -23,9 +23,18 @@ sub run_eval {
     my $code = $data->param('code') // '';
     my $language = $data->param('language') // 'perl';
 
-    my $output = $self->eval->get_eval(undef, $code, $language);
+    $self->delay(sub {
+      my $delay = shift;
+      $self->eval->get_eval(undef, $code, [$language], $delay->begin(0,1));
 
-    $self->render(json => {evalout => $output});
+      return 1;
-};
+    },
+    sub {
+      my $delay = shift;
+      my ($output) = @_;
+
+      $self->render(json => {evalout => $output});
+    })
+}
 
 1;

lib/App/Controller/Paste.pm

@@ -80,13 +80,20 @@ sub get_paste {
     my $row = $c->paste->get_paste($pasteid); 
 
     if ($row) {
-        $c->stash($row);
+        $c->delay(sub {
-        $c->stash({language => $c->languages->get_language_hash->{$row->{language}}});
+            my $delay = shift;
-        $c->stash({page_tmpl => 'viewer.html'});
-        $c->stash({eval => $c->eval->get_eval($pasteid, $row->{paste}, $row->{language})});
-        $c->stash({paste_id => $pasteid});
 
-        $c->render('page');
+            $c->eval->get_eval($pasteid, $row->{paste}, [$row->{language}], $delay->begin(0,1));
+        }, sub {
+            my ($delay, $evalout) = @_;
+            $c->stash($row);
+            $c->stash({language => $c->languages->get_language_hash->{$row->{language}}});
+            $c->stash({page_tmpl => 'viewer.html'});
+            $c->stash({paste_id => $pasteid});
+            $c->stash({eval => $evalout});
+
+            $c->render('page');
+        });
     } else {
         return $c->reply->not_found;
     }

lib/App/Model/Eval.pm

@@ -10,75 +10,135 @@ use App::EvalServerAdvanced::Protocol;
 
 use App::Config;
 use App::Memcached;
+use Future::Mojo;
+use Mojo::IOLoop;
 
 has cfg => sub {App::Config::get_config('evalserver')}; 
 
-sub get_eval {
+our $id = 0; # global id count for evals
-    my ($self, $paste_id, $code, $lang) = @_;
 
-    if ($paste_id && (my $cached = $memd->get($paste_id))) {
+sub get_eval {
+    my ($self, $paste_id, $code, $langs, $callback) = @_;
+
+    if ($paste_id && (my $cached = $memd->get($paste_id))) { # TODO make this use sereal to store objects
         return $cached;
     } else {
+      # connect to server
+      my %futures;
 
-        $lang //= "perl";
+      my $server = $self->eval_connect(sub {
-        return undef if ($lang eq 'text');
+        my ($loop, $err, $stream) = @_;
 
-        my $str = eval {$self->do_singleeval($lang, $code)};
+        my $reader = $self->get_eval_reader($stream);
+        my %output;
 
-        return "ERROR: evalserver broken: $@" if $@;
+        for my $lang (@$langs) {
+          if ($lang eq 'text') {
+            next;
+          } else {
+            my $future = $self->async_eval($stream, $reader, $lang, $code);
+            $futures{$lang} = $future;
 
-        $memd->set($paste_id, $str) if ($paste_id);
+            $future->on_done(sub {
+              my ($out) = @_;
 
-        return $str;
+              print "Future is done\n";
+
+              $output{$lang} = $out;
+              delete $futures{$lang};
+
+              if (!keys %futures) { # I'm the last one
+                print "Calling memset\n";
+                $memd->set($paste_id, \%output) if ($paste_id);
+                print "Returning output to delay\n";
+                use Data::Dumper;
+                print Dumper(\%output);
+                $callback->(\%output);
+              }
+            });
+          }
+        }
+      });
     }
 }
 
-sub do_singleeval {
+sub eval_connect {
-  my ($self, $type, $code) = @_;
+  my ($self, $cb) = @_;
 
-  my $socket = IO::Socket::INET->new(PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14401)
+  my $loop = Mojo::IOLoop->singleton;
-    or die "error: cannot connect to eval server";
 
-  my $eval_obj = {language => $type, files => [{filename => '__code', contents => $code, encoding => "utf8"}], prio => {pr_realtime=>{}}, sequence => 1, encoding => "utf8"};
+  my $socket = $loop->client({address => $self->cfg->{server} // 'localhost', port => $self->cfg->{port} // 14401}, $cb);
 
-  $socket->autoflush(1);
+  return $socket;
-  print $socket encode_message(eval => $eval_obj);
+}
 
-  my $buf = '';
+sub async_eval {
-  my $data = '';
+  my ($self, $stream, $reader, $lang, $code) = @_;
-  my $resultstr = "Failed to read a message";
 
-  my $message = $self->read_message($socket);
+  my $loop = Mojo::IOLoop->singleton;
+  my $future = Future::Mojo->new($loop);
 
-  if (ref($message) =~ /Warning$/) {
+  my $seq = $id++;
-    return $message->message;
+  my $eval_obj = {language => $lang, 
-  } else {
+                 files => [
-    return $message->get_contents;
+                   {filename => '__code', contents => $code, encoding => "utf8"}
+                   ], 
+                 prio => {pr_deadline => {}}, 
+                 sequence => $seq, 
+                 encoding => "utf8"};
+
+  my $message = encode_message(eval => $eval_obj);
+
+  $reader->($seq, $future);
+  $stream->write($message);
+
+  return ($seq => $future);
+}
+
+sub get_eval_reader {
+  my ($self, $stream) = @_;
+
+  my %futures;
+  my %warnings;
+
+  my $buf;
+  my $out;
+
+  $stream->on(read => sub {
+    my ($stream, $bytes) = @_;
+
+    print "Reading bytes\n";
+
+    $buf = $buf . $bytes;
+    my ($res, $message, $nbuf) = decode_message($buf);
+    $buf = $nbuf;
+
+    if ($message) {
+
+      my $type = ref ($message);
+      $type =~ s/^App::EvalServerAdvanced::Protocol:://;
+
+      my $seq = $message->sequence;
+
+      if ($type eq 'Warning') {
+        push @{$warnings{$seq}}, $message->message;
+      } elsif ($type eq 'EvalResponse') {
+        print "Got eval response for $seq\n";
+        my $output = $message->get_contents;
+
+        my $warnings = join ' ', @{$warnings{$seq} || []};
+
+        $futures{$seq}->done($output);
+        print "Future is done: $output\n";
+      }
+    }
+  });
+
+  return sub {
+    print "WTF\n";
+    my ($seq, $future) = @_;
+    $futures{$seq} = $future;
   }
 }
 
-
-sub read_message {
-  my ($self, $socket) = @_;
-
-  my $header;
-  $socket->read($header, 8) or die "Couldn't read from socket";
-
-  my ($reserved, $length) = unpack "NN", $header;
-
-  die "Invalid packet" unless $reserved == 1;
-
-  my $buffer;
-  $socket->read($buffer, $length) or die "Couldn't read from socket2";
-
-  my ($res, $message, $nbuf) = decode_message($header . $buffer);
-
-
-  die "Data left over in buffer" unless $nbuf eq '';
-  die "Couldn't decode packet" unless $res;
-
-  return $message;
-}
-
-
 1;