Merge branch 'master' of github.com:perlbot/perlbuut-pastebin

cpanfile

@@ -10,3 +10,4 @@ requires 'Mojolicious::Lite';
 requires 'Mojolicious::Plugin::TtRenderer';
 requires 'Mojolicious::Plugin::BlogSpam';
 requires 'App::EvalServerAdvanced::Protocol';
+requires 'Future::Mojo';

lib/App/Controller/Apiv1.pm

@@ -28,16 +28,27 @@ sub api_get_paste {
     my $row = $c->paste->get_paste($pasteid); 
 
     if ($row) {
+      $c->delay(sub {
+        my ($delay) = @_;
+          $c->eval->get_eval($pasteid, $row->{paste}, [$row->{language}], $delay->begin(0, 1))
+        },
+        sub {
+          my ($delay, $output_hr) = @_;
+
+          my ($output_lang) = keys %$output_hr; # grab a random output value, should be the first one since multilang support isn't working yet
+          my ($output) = $output_hr->{$output_lang};
           my $data = {
             paste => $row->{paste},
             when => $row->{when},
             username => $row->{who},
             description => $row->{desc},
-          language => $row->{language},
-          output => $c->eval->get_eval($pasteid, $row->{paste}, $row->{language})
+            language => $output_lang,
+            output => $output,
+            warning => "If this was multi-language paste, you just got a random language",
           };
 
           $c->render(json => $data);
+        });
     } else {
 # 404
         return $c->reply->not_found;

lib/App/Controller/Eval.pm

@@ -20,12 +20,25 @@ sub run_eval {
     my ($self) = @_;
     my $data = $self->req->body_params;
 
+
+
+    $self = $self->inactivity_timeout(3600);
+
     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));
+
+      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->delay(sub {
+            my $delay = shift;
+
+            $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({eval => $c->eval->get_eval($pasteid, $row->{paste}, $row->{language})});
             $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,170 @@ use App::EvalServerAdvanced::Protocol;
 
 use App::Config;
 use App::Memcached;
+use Future::Mojo;
+use Mojo::IOLoop;
 
 has cfg => sub {App::Config::get_config('evalserver')}; 
 
+our $id = 0; # global id count for evals
+my %_futures;
+
+sub _adopt_future {
+  my ($self, $id, $future) = @_;
+
+  $_futures{$id} = $future;
+
+  $future->on_ready(sub {
+    print "Cleaning up $id\n";
+    delete $_futures{$id};
+  })
+}
+
+
 sub get_eval {
-    my ($self, $paste_id, $code, $lang) = @_;
+    my ($self, $paste_id, $code, $langs, $callback) = @_;
+    print "Entering\n";
 
+    if (@$langs == 1 && $langs->[0] eq "evalall") {
+      $langs = [qw/perl perl5.26 perl5.24 perl5.22 perl5.20 perl5.18 perl5.16 perl5.14 perl5.12 perl5.10 perl5.8 perl5.6/];
+    }
+
+    use Data::Dumper;
+    print "Languages! ", Dumper($langs);
     if ($paste_id && (my $cached = $memd->get($paste_id))) {
-        return $cached;
+      $callback->($cached);
     } else {
+      # connect to server
+      my %futures;
 
-        $lang //= "perl";
-        return undef if ($lang eq 'text');
+      my $server = $self->eval_connect(sub {
+        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 $@;
-
-        $memd->set($paste_id, $str) if ($paste_id);
-
-        return $str;
-    }
-}
-
-sub do_singleeval {
-  my ($self, $type, $code) = @_;
-
-  my $socket = IO::Socket::INET->new(PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14401)
-    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"};
-
-  $socket->autoflush(1);
-  print $socket encode_message(eval => $eval_obj);
-
-  my $buf = '';
-  my $data = '';
-  my $resultstr = "Failed to read a message";
-
-  my $message = $self->read_message($socket);
-
-  if (ref($message) =~ /Warning$/) {
-    return $message->message;
+        for my $lang (@$langs) {
+          if ($lang eq 'text') {
+            $callback->("");
+            return;
           } else {
-    return $message->get_contents;
+            my $future = $self->async_eval($stream, $reader, $lang, $code);
+            $futures{$lang} = $future;
+
+            $future->on_done(sub {
+              my ($out) = @_;
+
+              print "Future is done for $lang\n";
+
+              $output{$lang} = $out;
+              delete $futures{$lang};
+
+              print "remaining, ", Dumper(keys %futures);
+
+              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 eval_connect {
+  my ($self, $cb) = @_;
 
-sub read_message {
-  my ($self, $socket) = @_;
+  my $loop = Mojo::IOLoop->singleton;
 
-  my $header;
-  $socket->read($header, 8) or die "Couldn't read from socket";
+  my $socket = $loop->client({address => $self->cfg->{server} // 'localhost', port => $self->cfg->{port} // 14401}, $cb);
 
-  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;
+  return $socket;
 }
 
+sub async_eval {
+  my ($self, $stream, $reader, $lang, $code) = @_;
+
+  my $loop = Mojo::IOLoop->singleton;
+  my $future = Future::Mojo->new($loop);
+
+  my $seq = $id++;
+
+  $self->_adopt_future($seq, $future);
+  my $eval_obj = {language => $lang, 
+                 files => [
+                   {filename => '__code', contents => $code, encoding => "utf8"}
+                   ], 
+                 prio => {pr_realtime => {}}, 
+                 sequence => $seq, 
+                 encoding => "utf8"};
+
+  use Data::Dumper;
+  print Dumper($eval_obj);
+
+  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);
+    do {
+      ($res, $message, $nbuf) = decode_message($buf);
+      $buf = $nbuf;
+      print Dumper($message);
+
+      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";
+        }
+      };
+
+    } while ($res);
+
+    return 0;
+  });
+
+  return sub {
+    my ($seq, $future) = @_;
+    print "Registering $seq\n";
+    $futures{$seq} = $future;
+  }
+}
 
 1;

lib/App/Model/Languages.pm

@@ -22,6 +22,7 @@ my @langs = (
     {name => "perl5.10",  mode => "perl", description => "Perl 5.10"},
     {name => "perl5.8",   mode => "perl", description => "Perl 5.8"},
     {name => "perl5.6",   mode => "perl", description => "Perl 5.6"},
+    {name => "evalall",  mode => "perl", description => "Perl (EvalAll)"},
     {name => "perl5.5",   mode => "perl", description => "Perl 5.5"},
     {name => "perl4",     mode => "perl", description => "Perl 4.0.36"},
     {name => "perl3",     mode => "perl", description => "Perl 3.0.1.10_44"},

public/extern

@@ -0,0 +1 @@
+../extern

public/static

@@ -0,0 +1 @@
+../static

templates/editor.html

@@ -270,7 +270,20 @@
         data: {code: code, language: language},
         dataType: "json",
         success: function(data, status) {
-          $('#eval').text(data.evalout);
+	  console.log("data out", data);
+	  var keys = Object.keys(data.evalout);
+	  var outputarr = [];
+
+          if (keys.length > 1) {
+            outputarr = $.map(data.evalout, function(output, lang) {
+             return "[[ "+lang+" ]]\n"+output+"\n\n";
+	    });
+          } else {
+            outputarr = [data.evalout[keys[0]]];
+          }
+          console.log("outputarr", outputarr);
+
+	  $('#eval').text(Array.join(outputarr, "\n"));
         }
       });
     });

templates/viewer.html

@@ -69,12 +69,14 @@
             <pre id="editor"></pre>
           </div>
         </div>
+	[% FOR lang IN eval.keys %]
         <div class="row">
           <div id="eval" class="col-md-12">
-            <h3>Program Output:</h3>
-            <pre>[% eval | html %]</pre>
+            <h3>Program Output as [% lang %]:</h3>
+            <pre>[% eval.$lang | html %]</pre>
           </div>
         </div>
+        [% END %]
         <div class="panel-footer">
           <input value="Fork and Edit" type="submit" id="submit" />
         </div>