perl: plack: update and async version (#4517)

frameworks/Perl/plack/README.md

@@ -2,22 +2,11 @@
 
 Plack
 
-# Setup
-
-* Perl 5.12+
-* MySQL 5.5
-* Wrk 2.0
-
 # Requirements
 
 * Plack
-* Starlet
-* HTTP::Parser::XS
+* Gazelle
+* Twiggy::Prefork
 * JSON::XS
-* DBI
+* AnyEvent::DBI
 * DBD::mysql
-
-# Deployment
-
-    plackup -E production -s Starlet --max-keepalive-reqs 5000 \
-      --max-reqs-per-child 50000 --min-reqs-per-child 40000 --workers=2 -l :8080 app.psgi

frameworks/Perl/plack/app-async.psgi

@@ -0,0 +1,39 @@
+use strict; use feature 'state';
+use JSON::XS 'encode_json';
+use AnyEvent; use EV;
+use AnyEvent::DBI;
+use Unix::Processors;
+use List::Util qw'min max';
+
+my @dsn = ('dbi:mysql:database=hello_world;host=tfb-database;port=3306', 'benchmarkdbuser', 'benchmarkdbpass');
+my $query = 'select randomNumber from World where id = ?';
+
+sub {
+    my $env = shift;
+    my $path = $env->{PATH_INFO};
+    return [200, [qw(Content-Type application/json)], [encode_json(+{ message => 'Hello, World!' })]] if $path eq '/json';
+    return [200, [qw(Content-Type text/plain)], ['Hello, World!']] if $path eq '/plaintext';
+    if ($path eq '/db') {
+        state $cpus = Unix::Processors->new->max_online;
+        state $dbh = [map AnyEvent::DBI->new(@dsn, on_error => sub { warn }), 1 .. $cpus * 4];
+	state $dbh_idx = 0;
+    	my ($n) = ($env->{QUERY_STRING} // '' ) =~ m/queries=(\d+)/;
+        $n = max(1, min($n//1, 500));
+	return sub {
+	    my $res = shift;
+            my @rs; my $cv = AE::cv;
+	    my $done_cb = sub { $res->([200, [qw(Content-Type application/json)], [encode_json($env->{QUERY_STRING} ? \@rs : $rs[0] // {})]]) };
+	    for my $qn (1..$n) {
+	         $cv->begin($done_cb);
+	 	 my $id = int(rand 10000) + 1;
+                 $dbh->[$dbh_idx++]->exec($query, $id, sub {
+		     my (undef, $rows) = @_;
+		     push @rs, map +{ id => $id, randomNumber => 0+ $_->[0] }, @$rows;
+		     $cv->end;
+                 });
+		 $dbh_idx = $dbh_idx % @$dbh if $dbh_idx >= @$dbh;
+	    }
+	}
+    }
+    [404, [qw(Content-Type application/json)], ['not found']]
+}

frameworks/Perl/plack/app.pl

@@ -0,0 +1,29 @@
+use strict;
+use Unix::Processors;
+use Getopt::Std 'getopts'; getopts('a', my $opts = +{});
+use Cwd 'getcwd';
+
+my $cpus = Unix::Processors->new->max_online;
+
+my @cmd = (
+    ($opts->{a} # async server
+     ? [qw'plackup -s Twiggy::Prefork -E production --max-reqs-per-child=0 --backlog 16384
+           --max-workers', $cpus, qw'-l /dev/shm/app.sock -a app-async.psgi']
+     : [qw'start_server --backlog 16384 --path /dev/shm/app.sock --
+           plackup -s Gazelle -E production --max-reqs-per-child 10000000
+           --max-workers', $cpus, qw'-a app.psgi']),
+    [qw'nginx -c nginx.conf -p', getcwd]
+);
+
+my @child;
+for (@cmd) {
+    if ((my $pid = fork) > 0) { push @child, $pid }
+    elsif (defined $pid) { exec @$_ }
+    else { die 'fork failed' }
+}
+
+# wait childs
+$SIG{INT} = $SIG{TERM} = sub { kill TERM => @child; 1 while wait != -1 };
+1 while wait != -1;
+
+exit 0;

frameworks/Perl/plack/app.psgi

@@ -1,34 +1,27 @@
-use strict;
-use v5.16;
-use utf8;
-use JSON::XS qw(encode_json);
+use strict; use feature 'state';
+use JSON::XS 'encode_json';
 use DBI;
+use List::Util qw'min max';
 
-my $dbh = DBI->connect_cached(
-    'dbi:mysql:database=hello_world;host=tfb-database;port=3306',
-    'benchmarkdbuser',
-    'benchmarkdbpass',
-    { AutoInactiveDestroy => 1, mysql_enable_utf8 => 1 }
-) || die $!;
-
-my $query = 'SELECT id, randomNumber FROM World WHERE id = ?';
-my $header = [qw(Content-Type application/json)];
-my $message = { message => 'Hello, World!' };
-
-my $app = sub {
+sub {
+    state $dbh = DBI->connect(
+	'dbi:mysql:database=hello_world;host=tfb-database;port=3306',
+	'benchmarkdbuser', 'benchmarkdbpass',
+	+{ qw'RaiseError 0 PrintError 0 mysql_enable_utf8 1' }
+    ) || die $!;
+    state $sth = $dbh->prepare('select randomnumber from world where id = ?');
     my $env = shift;
-    if ( $env->{PATH_INFO} eq '/json' ) {
-        return [ 200, $header, [ encode_json($message) ]];
-    }
-    elsif ( $env->{PATH_INFO} eq '/db' ) {
-        my ($n) = ($env->{QUERY_STRING} || "" ) =~ m!queries=(\d+)!;
-        $n //= 1;
-        my @rs = map {{id=>$_->[0]+0,randomNumber=>$_->[1]+0}} 
-            map { $dbh->selectrow_arrayref($query,{},int rand 10000 + 1) } 1..$n;
-        return [ 200, $header, [ '{}' ]] unless @rs;
-        return [ 200, $header, [ encode_json( @rs > 1 ? \@rs : $rs[0] ) ]];
+    my $path = $env->{PATH_INFO};
+    return [200, [qw(Content-Type application/json)], [encode_json(+{ message => 'Hello, World!' })]] if $path eq '/json';
+    return [200, [qw(Content-Type text/plain)], ['Hello, World!']] if $path eq '/plaintext';
+    if ( $path eq '/db' ) {
+	my ($n) = ($env->{QUERY_STRING} // '' ) =~ m/queries=(\d+)/;
+	$n = max(1, min($n//1, 500));
+	my @rs = map {
+	    $sth->execute(my $id = int(rand 10000) + 1);
+	    +{ id => $id, randomNumber => 0+ $sth->fetch->[0] }
+	} 1..$n;
+	return [ 200, [qw(Content-Type application/json)], [encode_json($env->{QUERY_STRING} ? \@rs : $rs[0] // {})]];
     }
     [ 404, [], ['not found']];
-};
-
-$app;
+}

frameworks/Perl/plack/benchmark_config.json

@@ -4,6 +4,8 @@
     "default": {
       "json_url": "/json",
       "db_url": "/db",
+      "query_url": "/db?queries=",
+      "plaintext_url": "/plaintext",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Micro",
@@ -11,13 +13,33 @@
       "framework": "plack",
       "language": "Perl",
       "orm": "Raw",
-      "platform": "Starlet",
+      "platform": "Plack",
       "webserver": "nginx",
       "os": "Linux",
       "database_os": "Linux",
       "display_name": "plack",
       "notes": "",
-      "versus": ""
+      "versus": "plack-async"
+    },
+    "async": {
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/db?queries=",
+      "plaintext_url": "/plaintext",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Micro",
+      "database": "MySQL",
+      "framework": "plack",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "AnyEvent",
+      "webserver": "nginx",
+      "os": "Linux",
+      "database_os": "Linux",
+      "display_name": "plack-async",
+      "notes": "",
+      "versus": "plack"
     }
   }]
 }

frameworks/Perl/plack/nginx.conf

@@ -1,33 +1,28 @@
 user root;
 error_log stderr error;
-
-worker_processes 2;
+worker_processes auto;
 
 events {
-  worker_connections  1024;
+  use epoll;
+  worker_connections 16384;
   multi_accept on;
 }
 
 http {
-  client_body_temp_path      /tmp;
-
-  output_buffers   1 32k;
-  postpone_output  1460;
-
   access_log       off;
-
   sendfile         on;
   tcp_nopush       on;
-
   tcp_nodelay      on;
-
+  etag off;
+  keepalive_requests 10000000;
+  upstream app {
+    server unix:/dev/shm/app.sock max_fails=0;
+  }
   server {
-    listen 8080;
-    server_name localhost;
-
+    listen 0.0.0.0:8080 default_server;
     location / {
-      proxy_pass http://unix:/tmp/perl-plack.sock;
+      proxy_pass http://app;
+      proxy_ignore_client_abort on;
     }
-
   }
 }

frameworks/Perl/plack/plack-async.dockerfile

@@ -0,0 +1,11 @@
+FROM perl:latest
+
+RUN apt update -yqq && apt install -yqq nginx
+RUN cpanm --notest --no-man-page Plack JSON::XS Unix::Processors DBI DBD::mysql
+RUN cpanm --notest --no-man-page Cookie::Baker::XS Twiggy::Prefork HTTP::Parser::XS EV AnyEvent::DBI
+
+ADD nginx.conf ./
+ADD app.pl ./
+ADD app-async.psgi ./
+
+CMD perl app.pl -a

frameworks/Perl/plack/plack.dockerfile

@@ -1,23 +1,11 @@
-FROM perl:5.26
+FROM perl:latest
 
 RUN apt update -yqq && apt install -yqq nginx
+RUN cpanm --notest --no-man-page Plack JSON::XS Unix::Processors DBI DBD::mysql
+RUN cpanm --notest --no-man-page Gazelle Cookie::Baker::XS
 
-WORKDIR /plack
+ADD nginx.conf ./
+ADD app.pl ./
+ADD app.psgi ./
 
-RUN cpanm --notest --no-man-page \
-        JSON JSON::XS IO::Socket::IP IO::Socket::SSL \
-        JSON::[email protected] \
-        HTTP::Parser::[email protected] \
-        [email protected] \
-        [email protected] \
-        DBD::[email protected] \
-        [email protected]
-
-ADD ./app.pid /plack/
-ADD ./app.psgi /plack/
-add ./nginx.conf /plack/
-
-CMD nginx -c /plack/nginx.conf && \
-    start_server --backlog=16384 --pid-file=/plack/app.pid --path=/tmp/perl-plack.sock -- plackup \
-    -E production -s Starlet --max-keepalive-reqs 1000 --max-reqs-per-child 50000 \
-    --min-reqs-per-child 40000 --max-workers=$(nproc) -a /plack/app.psgi
+CMD perl app.pl