Perl Kelp: Fix and modernize (#9115)

* Perl Kelp: Fix and modernize

* Perl Kelp: benchmark on multiple web servers

* Perl Kelp: unfreeze framework version, a couple of fixes

frameworks/Perl/kelp/README.md

@@ -1,18 +1,17 @@
 # Setup
 
-* Perl 5.10+
-* MySQL 5.5
-* MongoDB
-* Wrk 2.0
+* Perl 5.36+
+* MariaDB or MongoDB
 
 # Requirements
 
 * Kelp (install from CPAN)
-* Kelp::Module::JSON::XS (install from CPAN)
 * Kelp::Module::Template::Toolkit (install from CPAN)
-* DBD::mysql (install from CPAN)
+* DBI + DBD::mysql or MongoDB (install from CPAN)
+* Gazelle (install from CPAN)
 * Starman (install from CPAN)
-* MongoDB (install from CPAN)
+* Starlet (install from CPAN)
+* Twiggy::Prefork (install from CPAN)
 * nginx (if you want to front with nginx, nginx.conf provided)
 
 # Deployment
@@ -24,16 +23,38 @@
 
     ./uwsgi --plugins psgi --init app.ini
 
-## Plack + Starman
+## Plack + plack handler
 
-1. Deploy via plackup
+Recommended handler is `Gazelle`.
 
-    plackup -E deployment -s Starman --workers=25 -l /tmp/frameworks-benchmark.sock -a ./app.pl
+1. Deploy via `start_server`, if you want to front it with nginx.
 
-2. If you want to front it with nginx, otherwise
+    start_server --path /tmp/perl-kelp.sock --backlog 16384 -- plackup -E production -s Gazelle --max-workers=25 --max-reqs-per-child=10000 -a ./app.psgi
 
-    plackup -E deployment -s Starman --port=8080 --workers=25 -a ./app.pl
+2. Otherwise
+
+    plackup -E deployment -s Gazelle --port=8080 --max-workers=25 -a ./app.psgi
+
+# Code information
+
+`lib/KelpBench.pm` contains all action-handling and helper code. It is a full
+Kelp app with `Template::Toolkit` module and standard Kelp configuration files.
+While it could've been coded as a one-file Kelp app, full app style gives us
+more control on the behavior of the app.  It lazy-loads `DBI.pm` or `Mongo.pm`
+from `lib/KelpBench/` directory based on environmental variable `MONGO`, so it
+only needs one database driver at a time.
+
+The app is written in a relaxed style, not trying very hard to achieve the best
+possible result. It very much resembles production code. For example, a proper
+templating engine is used to produce the HTML document instead of inline HTML
+(which is obviously much faster).
+
+App can be tested using mock database by running `prove -l`. In this case, it
+only requires `Kelp` and `Kelp::Module::Template::Toolkit` from CPAN to be
+installed.
 
 # Expert contact
 
+@bbrtj ([email protected])
 @naturalist ([email protected])
+

frameworks/Perl/kelp/app.ini

@@ -1,4 +1,5 @@
 [uwsgi]
 http-socket = :8080
-psgi = app.pl
+psgi = app.psgi
 disable-logging = True
+

frameworks/Perl/kelp/app.pl

@@ -1,145 +0,0 @@
-#!/usr/bin/env perl
-
-use Kelp::Less;
-use HTML::Escape 'escape_html';
-use MongoDB;
-use DBI;
-use utf8;
-
-module 'JSON::XS';
-
-my $mongo;
-my $mdb;
-my $world;
-my $fortune;
-my @sth;
-my $dbh;
-
-if ($ENV{MONGO}) {
-    $mongo   = MongoDB::MongoClient->new( host => 'tfb-database', port => 27017 );
-    $mdb     = $mongo->get_database('hello_world');
-    $world   = $mdb->get_collection('world');
-    $fortune = $mdb->get_collection('fortune');
-} else {
-    $dbh = DBI->connect(
-        "dbi:mysql:database=hello_world;host=tfb-database;port=3306",
-        'benchmarkdbuser',
-        'benchmarkdbpass',
-        { RaiseError => 0, PrintError => 0, mysql_enable_utf8 => 1 }
-    );
-    @sth = map { $dbh->prepare($_) } (
-        "SELECT * FROM World WHERE id = ?",
-        "SELECT * FROM Fortune",
-        "UPDATE World SET randomNumber = ? WHERE id = ?",
-    );
-}
-
-get '/json' => sub {
-    { message => 'Hello, World!' };
-};
-
-get '/db/?db' => sub {
-    my ( $self, $db ) = @_;
-    my $id = int rand 10000 + 1;
-    my $row;
-    if ( $db eq 'mongo' ) {
-        $row = $world->find_one( { _id => $id } );
-    }
-    else {
-        $sth[0]->execute($id);
-        $row = $sth[0]->fetchrow_hashref;
-    }
-    return { id => $id, randomNumber => $row->{randomNumber} };
-};
-
-get '/queries/?db' => sub {
-    my ( $self, $db ) = @_;
-    query( $db // 'mongo', $self->param('queries') );
-};
-
-get '/fortunes/?db' => sub {
-    my ( $self, $db ) = @_;
-    $db //= 'mongo';
-    my @objects;
-    if ( $db eq 'mongo' ) {
-        my $cursor = $fortune->query( {} );
-        @objects = $cursor->all;
-    }
-    else {
-        $sth[1]->execute();
-        @objects = @{ $sth[1]->fetchall_arrayref( {} ) };
-    }
-    push @objects, { id => 0, message => "Additional fortune added at request time." };
-    fortunes( \@objects );
-};
-
-get '/update/?db' => sub {
-    my ( $self, $db ) = @_;
-    $db //= 'mongo';
-
-    my $arr = query( $db, $self->param('queries') );
-    $arr = [$arr] unless ref($arr) eq 'ARRAY';
-    for my $row (@$arr) {
-        $row->{randomNumber} = int( rand(10_000) ) + 1;
-        if ( $db eq 'mongo' ) {
-            $world->update( { _id => $row->{id} },
-                { randomNumber => $row->{randomNumber} } );
-        }
-        else {
-            $row->{randomNumber} = int( rand(10_000) ) + 1;
-            $sth[2]->execute( $row->{randomNumber}, $row->{id} );
-        }
-    }
-
-    return $arr;
-};
-
-get '/plaintext' => sub {
-    shift->res->text->render('Hello, World!');
-};
-
-run;
-
-sub query {
-    my ( $db, $count ) = @_;
-    $count //= 1;
-    $count = 1 if ( $count !~ /^\d+$/ || $count < 1 );
-    $count = 500 if $count > 500;
-    my @response;
-    for ( 1 .. $count ) {
-        my $id = int rand 10000 + 1;
-        my $row;
-        if ( $db eq 'mongo' ) {
-            $row = $world->find_one( { _id => $id } );
-        }
-        else {
-            $sth[0]->execute($id);
-            $row = $sth[0]->fetchrow_hashref;
-        }
-        if ($row) {
-            push @response,
-                  { id => $id, randomNumber => $row->{randomNumber} };
-        }
-    }
-    return \@response;
-}
-
-sub fortunes {
-    my ($objects) = @_;
-    my $res = q[<!DOCTYPE html><html><head><title>Fortunes</title></head>];
-    $res .= q[<body><table><tr><th>id</th><th>message</th></tr>];
-
-    for my $item ( sort { $a->{message} cmp $b->{message} } @$objects ) {
-        my $id = $item->{id};
-        my $message = escape_html( $item->{message} );
-
-        # HTML::Escape encodes apostrophe as &#39; because IE8 does not
-        # support &apos;. We forse an &apos; here in order to pass the
-        # test
-        $message =~ s/&#39/&apos/g;
-        $res .= "<tr><td>$id</td><td>$message</td></tr>";
-    }
-
-    $res .= q[</table></body></html>];
-    return $res;
-}

frameworks/Perl/kelp/app.psgi

@@ -0,0 +1,8 @@
+#!/usr/bin/env perl
+
+use Path::Tiny qw(path);
+use lib path(__FILE__)->parent->child('lib');
+use KelpBench;
+
+KelpBench->new->run;
+

frameworks/Perl/kelp/benchmark_config.json

@@ -1,11 +1,61 @@
 {
   "framework": "kelp",
   "tests": [{
-    "default": {
-      "db_url": "/db/mysql",
-      "query_url": "/queries/mysql?queries=",
-      "fortune_url": "/fortunes/mysql",
+    "gazelle-mysql": {
+      "dockerfile": "kelp.dockerfile",
       "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MySQL",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Gazelle",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
+    },
+    "gazelle-mongodb": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MongoDB",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Gazelle",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
+    },
+
+    "starman-mysql": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Fullstack",
@@ -17,16 +67,18 @@
       "webserver": "Starman",
       "os": "Linux",
       "database_os": "Linux",
-      "display_name": "kelp",
       "notes": "",
       "versus": "",
-      "tags": ["broken"]
+      "tags": []
     },
-    "mongodb": {
-      "db_url": "/db/mongo",
-      "query_url": "/queries/mongo?queries=",
-      "fortune_url": "/fortunes/mongo",
+    "starman-mongodb": {
+      "dockerfile": "kelp.dockerfile",
       "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Fullstack",
@@ -38,10 +90,102 @@
       "webserver": "Starman",
       "os": "Linux",
       "database_os": "Linux",
-      "display_name": "kelp",
       "notes": "",
       "versus": "",
-      "tags": ["broken"]
+      "tags": []
+    },
+
+    "starlet-mysql": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MySQL",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Starlet",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
+    },
+    "starlet-mongodb": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "update_url": "/updates?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MongoDB",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Starlet",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
+    },
+
+    "twiggy-mysql": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MySQL",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Twiggy",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
+    },
+    "twiggy-mongodb": {
+      "dockerfile": "kelp.dockerfile",
+      "plaintext_url": "/plaintext",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "fortune_url": "/fortunes",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MongoDB",
+      "framework": "kelp",
+      "language": "Perl",
+      "orm": "Raw",
+      "platform": "Plack",
+      "webserver": "Twiggy",
+      "os": "Linux",
+      "database_os": "Linux",
+      "notes": "",
+      "versus": "",
+      "tags": []
     }
   }]
 }
+

frameworks/Perl/kelp/conf/config.pl

@@ -0,0 +1,12 @@
+{
+	modules => [qw(JSON Template::Toolkit)],
+	modules_init => {
+		'Template::Toolkit' => {
+			STRICT => 1,
+			OUTLINE_TAG => qr{\V*%%}, # https://github.com/abw/Template2/issues/320
+			ENCODING => 'utf8',
+			INCLUDE_PATH => 'views',
+		},
+	},
+}
+

frameworks/Perl/kelp/conf/test.pl

@@ -0,0 +1,23 @@
+{
+	'+modules' => [qw(Logger)],
+
+	modules_init => {
+		Logger => {
+			outputs => [
+				[
+					'Screen',
+					name      => 'logs',
+					min_level => 'debug',
+					stderr => 1,
+					newline => 1,
+					utf8 => 1,
+				],
+			],
+		},
+
+		'Template::Toolkit' => {
+			DEBUG => 1,
+		},
+	},
+}
+

frameworks/Perl/kelp/config.toml

@@ -1,32 +0,0 @@
-[framework]
-name = "kelp"
-
-[main]
-urls.plaintext = "/plaintext"
-urls.db = "/db/mysql"
-urls.query = "/queries/mysql?queries="
-urls.fortune = "/fortunes/mysql"
-approach = "Realistic"
-classification = "Fullstack"
-database = "MySQL"
-database_os = "Linux"
-os = "Linux"
-orm = "Raw"
-platform = "Plack"
-webserver = "Starman"
-versus = ""
-
-[mongodb]
-urls.plaintext = "/plaintext"
-urls.db = "/db/mongo"
-urls.query = "/queries/mongo?queries="
-urls.fortune = "/fortunes/mongo"
-approach = "Realistic"
-classification = "Fullstack"
-database = "MongoDB"
-database_os = "Linux"
-os = "Linux"
-orm = "Raw"
-platform = "Plack"
-webserver = "Starman"
-versus = ""

frameworks/Perl/kelp/kelp-mongodb.dockerfile

@@ -1,27 +0,0 @@
-FROM perl:5.26
-
-RUN apt-get update -yqq && apt-get install -yqq nginx
-
-WORKDIR /kelp
-
-RUN cpanm --notest --no-man-page \
-        JSON JSON::XS IO::Socket::IP IO::Socket::SSL \
-        [email protected] \
-        [email protected] \
-        DBD::[email protected] \
-        [email protected] \
-        Kelp::Module::JSON::[email protected] \
-        HTML::[email protected] \
-        HTTP::Parser::[email protected] \
-        [email protected]
-
-ADD ./app.ini /kelp/
-ADD ./app.pl /kelp/
-ADD ./nginx.conf /kelp/
-
-ENV MONGO=1
-
-EXPOSE 8080
-
-CMD nginx -c /kelp/nginx.conf && \
-    plackup -E production -s Starman --workers=$(nproc) -l /tmp/perl-kelp.sock -a ./app.pl

frameworks/Perl/kelp/kelp.dockerfile

@@ -1,25 +1,33 @@
-FROM perl:5.26
+FROM perl:5.40
+
+ARG TFB_TEST_NAME
+ARG TFB_TEST_DATABASE
 
 RUN apt-get update -yqq && apt-get install -yqq nginx
 
 WORKDIR /kelp
 
 RUN cpanm --notest --no-man-page \
-        JSON JSON::XS IO::Socket::IP IO::Socket::SSL \
-        [email protected] \
-        [email protected] \
-        DBD::[email protected] \
-        [email protected] \
-        Kelp::Module::JSON::[email protected] \
-        HTML::[email protected] \
-        HTTP::Parser::[email protected] \
-        [email protected]
-
-ADD ./app.ini /kelp/
-ADD ./app.pl /kelp/
-ADD ./nginx.conf /kelp/
+	Kelp::Module::Template::[email protected] \
+	Kelp \
+	[email protected] \
+	DBD::[email protected] \
+	[email protected] \
+	Cpanel::JSON::[email protected] \
+	[email protected] \
+	[email protected] \
+	[email protected] \
+	Twiggy::[email protected] \
+	Net::Server::SS::[email protected]
+
+ADD ./ /kelp/
+
+ENV TEST_NAME=$TFB_TEST_NAME
+ENV DATABASE=$TFB_TEST_DATABASE
+ENV MAX_REQS=100000
+ENV SOCKET_FILE=/tmp/perl-kelp.sock
 
 EXPOSE 8080
 
-CMD nginx -c /kelp/nginx.conf && \
-    plackup -E production -s Starman --workers=$(nproc) -l /tmp/perl-kelp.sock -a ./app.pl
+CMD nginx -c /kelp/nginx.conf && ./run.pl
+

frameworks/Perl/kelp/lib/KelpBench.pm

@@ -0,0 +1,130 @@
+package KelpBench;
+
+use v5.36;
+use Kelp::Base 'Kelp';
+
+## Attributes
+
+attr database => sub {
+	if (lc $ENV{DATABASE} eq 'mongodb') {
+		require KelpBench::Mongo;
+		return KelpBench::Mongo->new;
+	}
+	elsif (lc $ENV{DATABASE} eq 'mysql') {
+		require KelpBench::DBI;
+		return KelpBench::DBI->new;
+	}
+	else {
+		die "unknown database chosen: $ENV{DATABASE}";
+	}
+};
+
+## Utilities
+
+sub validate_number ($self, $num, $min, $max)
+{
+	return $min unless length($num // '') && $num !~ /\D/;
+	return $min if $num < $min;
+	return $max if $num > $max;
+	return $num;
+}
+
+sub random_number ($self, $max = 10_000)
+{
+	return int(rand($max) + 1);
+}
+
+sub random_id ($self)
+{
+	# in case random ids were not the same as random numbers
+	return $self->random_number(10_000);
+}
+
+sub get_random_entries ($self, $count)
+{
+	$count = $self->validate_number($count, 1, 500);
+
+	my @result;
+	for (1 .. $count) {
+		my $id = $self->random_id;
+		my $row = $self->database->random_number($id);
+		next unless $row;
+
+		push @result, {
+			id => $id,
+			randomNumber => $row->{randomNumber}
+		};
+	}
+
+	return \@result;
+}
+
+## Framework code
+
+sub before_dispatch {} # skip trying to log access
+sub before_finalize {} # skip adding X-Framework
+
+sub build ($self)
+{
+	$self->add_route([GET => '/plaintext'] => 'action_plaintext');
+	$self->add_route([GET => '/json'] => 'action_json');
+	$self->add_route([GET => '/db'] => 'action_db');
+	$self->add_route([GET => '/queries'] => 'action_queries');
+	$self->add_route([GET => '/fortunes'] => 'action_fortunes');
+	$self->add_route([GET => '/updates'] => 'action_updates');
+}
+
+## Registered route handlers
+## Names prefixed with _action, because we did not separate a controller
+## (Controllers would slow this down a bit due to reblessing of app object)
+
+sub action_plaintext ($self)
+{
+	$self->res->text;
+	return 'Hello, World!';
+}
+
+sub action_json ($self)
+{
+	return { message => 'Hello, World!' };
+}
+
+sub action_db ($self)
+{
+	my $id = $self->random_id;
+	my $row = $self->database->random_number($id);
+
+	return { id => $id, randomNumber => $row->{randomNumber} };
+}
+
+sub action_queries ($self)
+{
+	return $self->get_random_entries($self->req->query_param('queries'));
+}
+
+sub action_fortunes ($self) {
+	my $objects = $self->database->fortune;
+
+	push $objects->@*, {
+		id => 0,
+		message => "Additional fortune added at request time."
+	};
+
+	$objects->@* = sort { $a->{message} cmp $b->{message} } $objects->@*;
+	return $self->template('fortunes', { rows => $objects });
+}
+
+sub action_updates ($self)
+{
+	my $arr = $self->get_random_entries($self->req->query_param('queries'));
+
+	foreach my $row ($arr->@*) {
+		$row->{randomNumber} = $self->random_number;
+		$self->database->update($row->@{qw(id randomNumber)});
+	}
+
+	return $arr;
+};
+
+1;
+

frameworks/Perl/kelp/lib/KelpBench/DBI.pm

@@ -0,0 +1,47 @@
+package KelpBench::DBI;
+
+use v5.36;
+use Kelp::Base 'Kelp';
+use DBI;
+
+attr dbh => sub {
+	DBI->connect(
+		"dbi:MariaDB:database=hello_world;host=tfb-database;port=3306",
+		'benchmarkdbuser',
+		'benchmarkdbpass',
+		{ RaiseError => 1, PrintError => 0 }
+	);
+};
+
+attr _world => sub ($self) {
+	$self->dbh->prepare("SELECT * FROM World WHERE id = ?");
+};
+
+attr _fortune => sub ($self) {
+	$self->dbh->prepare("SELECT * FROM Fortune");
+};
+
+attr _update => sub ($self) {
+	$self->dbh->prepare("UPDATE World SET randomNumber = ? WHERE id = ?");
+};
+
+sub random_number ($self, $id)
+{
+	$self->_world->execute($id);
+	return $self->_world->fetchrow_hashref;
+}
+
+sub fortune ($self)
+{
+	$self->_fortune->execute();
+	return $self->_fortune->fetchall_arrayref({});
+}
+
+sub update ($self, $id, $random_number)
+{
+	$self->_update->execute($random_number, $id);
+	return;
+}
+
+1;
+

frameworks/Perl/kelp/lib/KelpBench/Mongo.pm

@@ -0,0 +1,43 @@
+package KelpBench::Mongo;
+
+use v5.36;
+use Kelp::Base 'Kelp';
+use MongoDB;
+
+attr dbh => sub {
+	MongoDB::MongoClient->new(
+		host => 'tfb-database',
+		port => 27017
+	)->get_database('hello_world');
+};
+
+attr _world => sub ($self) {
+	$self->dbh->get_collection('world');
+};
+
+attr _fortune => sub ($self) {
+	$self->dbh->get_collection('fortune');
+};
+
+sub random_number ($self, $id)
+{
+	return $self->_world->find_one({ _id => $id });
+}
+
+sub fortune ($self)
+{
+	return [$self->_fortune->find->all];
+}
+
+sub update ($self, $id, $random_number)
+{
+	$self->_world->update_one(
+		{ _id => $id },
+		{ '$set' => { randomNumber => $random_number } },
+	);
+
+	return;
+}
+
+1;
+

frameworks/Perl/kelp/run.pl

@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+
+use v5.36;
+use Data::Dumper;
+
+my $max_reqs = $ENV{MAX_REQS};
+my $test_name = $ENV{TEST_NAME};
+my $socket_file = $ENV{SOCKET_FILE};
+my $app_runner = 'app.psgi';
+
+my $max_workers = `nproc`;
+chomp $max_workers;
+
+my %runner_map = (
+	gazelle => [
+		'start_server',
+		'--path' => $socket_file,
+		'--backlog' => 16384,
+		'--',
+		'plackup',
+		'-E' => 'production',
+		'-s' => 'Gazelle',
+		'--max-workers' => $max_workers,
+		'--max-reqs-per-child' => $max_reqs,
+		'-a' => $app_runner,
+	],
+	starman => [
+		'start_server',
+		'--backlog' => 16384,
+		'--',
+		'plackup',
+		'-E' => 'production',
+		'-s' => 'Starman',
+		'-l' => $socket_file,
+		'--workers' => $max_workers,
+		'--max-requests' => $max_reqs,
+		'-a' => $app_runner,
+	],
+	starlet => [
+		'start_server',
+		'--path' => $socket_file,
+		'--backlog' => 16384,
+		'--',
+		'plackup',
+		'-E' => 'production',
+		'-s' => 'Starlet',
+		'--max-workers' => $max_workers,
+		'--max-reqs-per-child' => $max_reqs,
+		'-a' => $app_runner,
+	],
+	# NOTE: twiggy does not play well with Server::Starter
+	# NOTE: twiggy couldn't pass update tests, so I disabled them
+	twiggy => [
+		'plackup',
+		'-E' => 'production',
+		'-s' => 'Twiggy::Prefork',
+		'-l' => $socket_file,
+		'--backlog' => 16384,
+		'--max-workers' => $max_workers,
+		'--max-reqs-per-child' => $max_reqs,
+		'-a' => $app_runner,
+	],
+);
+
+die "invalid test name $test_name"
+	unless $test_name =~ m{^kelp-(\w+)-(\w+)$};
+
+die 'database mismatch'
+	unless $2 eq $ENV{DATABASE};
+
+my $command = $runner_map{$1};
+die "invalid server $1"
+	unless $command;
+
+say 'Running command: ' . Dumper($command);
+
+exec @$command;
+

frameworks/Perl/kelp/t/main.t

@@ -1,56 +1,107 @@
-use strict;
-use warnings;
+use v5.36;
 use utf8;
 
 use Kelp::Test;
 use Test::More;
 use Test::Deep;
 use HTTP::Request::Common;
+use KelpBench;
 
-my $t = Kelp::Test->new( psgi => 'app.pl');
-my $world = { randomNumber => re(qr{^\d+$}), id => re(qr{^\d+$}) };
+# use mock to avoid the need for DB modules and actual running DB
+# (however, we do not test for DB code correctness this way)
+package DBMock {
+	use v5.36;
+	use utf8;
 
-subtest 'json' => sub {
-    $t->request( GET '/json' )->json_cmp( { message => 'Hello, World!' } );
+	use Kelp::Base;
+
+	sub random_number ($self, $id)
+	{
+		return {
+			id => $id,
+			randomNumber => int(rand(10_000) + 1),
+		};
+	}
+
+	sub fortune ($self)
+	{
+		return [
+			{
+				id => 1,
+				message => 'フレームワークのベンチマーク',
+			},
+			{
+				id => 2,
+				message => '<script>test</script>',
+			},
+			{
+				id => 3,
+				message => '&&/\\+?',
+			},
+		];
+	}
+
+	sub update ($self, $id, $random_number)
+	{
+		return;
+	}
 };
 
+my $app = KelpBench->new(mode => 'test', database => DBMock->new);
+my $t = Kelp::Test->new(app => $app);
+my $world = { randomNumber => re(qr{^\d+$}), id => re(qr{^\d+$}) };
+
 subtest plaintext => sub {
-    $t->request( GET '/plaintext' )
-      ->content_type_is('text/plain')
-      ->content_is('Hello, World!');
+	my $uri = '/plaintext';
+
+	$t->request(GET $uri)
+		->content_type_is('text/plain')
+		->content_is('Hello, World!');
+};
+
+subtest 'json' => sub {
+	my $uri = '/json';
+
+	$t->request(GET $uri)
+		->json_cmp({ message => 'Hello, World!' });
 };
 
 subtest db => sub {
-    for my $uri (qw{/db /db/mongo}) {
-        $t->request( GET $uri )->json_cmp($world);
-    }
+	my $uri = '/db';
+
+	$t->request(GET $uri)
+		->json_cmp($world);
 };
 
 subtest queries => sub {
-    for my $uri (qw{/queries /queries/mongo}) {
-        $t->request( GET $uri )->json_cmp($world);
-        $t->request( GET "$uri?queries=3" )
-          ->json_cmp( [ $world, $world, $world ] );
-        $t->request( GET "$uri?queries=0" )->json_cmp($world);
-    }
+	my $uri = '/queries';
+
+	$t->request(GET $uri)
+		->json_cmp([$world]);
+	$t->request(GET "$uri?queries=3")
+		->json_cmp([$world, $world, $world]);
+	$t->request(GET "$uri?queries=0")
+		->json_cmp([$world]);
 };
 
 subtest update => sub {
-    for my $uri (qw{/update /update/mongo}) {
-        $t->request( GET $uri )->json_cmp([$world]);
-        $t->request( GET "$uri?queries=3" )
-          ->json_cmp( [ $world, $world, $world ] );
-    }
+	my $uri = '/updates';
+
+	$t->request(GET $uri)
+		->json_cmp([$world]);
+	$t->request(GET "$uri?queries=3")
+		->json_cmp([ $world, $world, $world ]);
 };
 
 subtest fortunes => sub {
-    for my $uri (qw{/fortunes /fortunes/mongo}) {
-        $t->request( GET $uri )
-          ->content_type_is('text/html')
-          ->content_like(qr{&lt;script&gt;})
-          ->content_like(qr{フレームワークのベンチマーク})
-          ->content_like(qr{Additional fortune added at request time.});
-    }
+	my $uri = '/fortunes';
+
+	$t->request(GET $uri)
+		->content_type_is('text/html')
+		->content_like(qr{&lt;script&gt;})
+		->content_like(qr{フレームワークのベンチマーク})
+		->content_like(qr{Additional fortune added at request time.});
 };
 
 done_testing;
+

frameworks/Perl/kelp/views/fortunes.tt

@@ -0,0 +1,22 @@
+<!DOCTYPE html>
+<html>
+	<head>
+		<title>Fortunes</title>
+	</head>
+	<body>
+		<table>
+			<tr>
+			<th>id</th>
+			<th>message</th>
+			</tr>
+
+			%% FOREACH row IN rows
+			<tr>
+			<td>[% row.id %]</td>
+			<td>[% row.message | html %]</td>
+			</tr>
+			%% END
+		</table>
+	</body>
+</html>
+