Home Explore Help
Sign In
compsci-industry
/
TechEmpower.FrameworkBenchmarks
mirror of https://github.com/TechEmpower/FrameworkBenchmarks.git
2
0
Fork 0
Files Issues 0 Wiki
Browse Source

Update the Perl Kelp framework

Added additional test routes according to the requirements at
http://www.techempower.com/benchmarks/#section=code
Stefan Geneshky 11 years ago
parent
d1a0219d87
commit
047cf84920
4 changed files with 79 additions and 31 deletions
Unified View Show Diff Stats
  1. 62 10
      kelp/app.pl
  2. 6 20
      kelp/benchmark_config
  3. 1 1
      kelp/conf/config.pl
  4. 10 0
      kelp/views/fortunes.tt

+ 62 - 10
kelp/app.pl
View File 

@@ -2,23 +2,77 @@
 
 use Kelp::Less;
 
 use Kelp::Less;
 
 use DBI;
 
 use DBI;
 
 
 
-my $dsn = "dbi:mysql:database=hello_world;host=localhost;port=3306";
 
-my $dbh = DBI->connect( $dsn, 'benchmarkdbuser', 'benchmarkdbpass', {} );
 
-my $sth = $dbh->prepare("SELECT * FROM World where id = ?");
 
+my $dsn  = "dbi:mysql:database=hello_world;host=localhost;port=3306";
 
+my $dbh  = DBI->connect( $dsn, 'benchmarkdbuser', 'benchmarkdbpass', {} );
 
+my $sth  = $dbh->prepare("SELECT * FROM World WHERE id = ?");
 
+my $sth1 = $dbh->prepare("SELECT * FROM Fortune");
 
+my $sth2 = $dbh->prepare("UPDATE World SET randomNumber = ? WHERE id = ?");
 
+
 
+get '/populate' => sub {
 
+    $dbh->do("DELETE FROM World");
 
+    $dbh->do("DELETE FROM Fortune");
 
+    srand;
 
+
 
+    # Add some random numbers
 
+    my @rand = map {'(' . $_ . ',' . int(rand(10_000)) . ')'} (1 .. 10_000);
 
+    $dbh->do(q[INSERT INTO World (id, randomNumber) VALUES ] . join(',', @rand));
 
+
 
+    # Add some fortunes
 
+    my @fortunes = map { '("' . 'x' x (int(rand(20)) + 1) . '")' } (1 .. 30);
 
+    $dbh->do(q[INSERT INTO Fortune (message) VALUES ] . join(',', @fortunes));
 
+
 
+    "OK";
 
+};
 
 
 
 get '/json' => sub {
 
 get '/json' => sub {
 
-    { message => 'Hello, World!' }
 
+    my $self = shift;
 
+    { message => 'Hello, World!' };
 
 };
 
 };
 
 
 
 get '/db' => sub {
 
 get '/db' => sub {
 
+    query(1);
 
+};
 
+
 
+get '/queries' => sub {
 
+    my $self = shift;
 
+    my $count = $self->param('queries') || 1;
 
+    query( $count > 500 ? 500 : $count );
 
+};
 
+
 
+get '/fortunes' => sub {
 
     my $self = shift;
 
     my $self = shift;
 
-    my $queries = $self->param('queries') || 1;
 
+    $sth1->execute();
 
+    my $fortunes = $sth1->fetchall_arrayref({});
 
+    $self->template( 'fortunes', { fortunes => $fortunes } );
 
+};
 
+
 
+get '/updates' => sub {
 
+    my $self  = shift;
 
+    my $count = $self->param('queries');
 
+    my $arr   = query( $count > 500 ? 500 : $count );
 
+    for my $row (@$arr) {
 
+        $row->{randomNumber} = int( rand(10_000) ) + 1;
 
+        $sth2->execute( $row->{randomNumber}, $row->{id} );
 
+    }
 
+
 
+    $arr;
 
+};
 
+
 
+get '/plaintext' => sub {
 
+    my $self = shift;
 
+    $self->res->text->render('Hello, World!');
 
+};
 
+
 
+run;
 
+
 
+sub query {
 
+    my $count = shift;
 
     my @response;
 
     my @response;
 
-    for ( 1 .. $queries ) {
 
+    for ( 1 .. $count ) {
 
         my $id = int rand 10000 + 1;
 
         my $id = int rand 10000 + 1;
 
         $sth->execute($id);
 
         $sth->execute($id);
 
         if ( my $row = $sth->fetchrow_hashref ) {
 
         if ( my $row = $sth->fetchrow_hashref ) {
 
-            if ( $queries == 1 ) {
 
+            if ( $count == 1 ) {
 
                 return { id => $id, randomNumber => $row->{randomNumber} };
 
                 return { id => $id, randomNumber => $row->{randomNumber} };
 
             }
 
             }
 
             else {
 
             else {
 
@@ -28,6 +82,4 @@ get '/db' => sub {
 
         }
 
         }
 
     }
 
     }
 
     return \@response;
 
     return \@response;
 
-};
 
-
 
-run;
 
+}

+ 6 - 20
kelp/benchmark_config
View File 

@@ -4,32 +4,18 @@
 
     "default": {
 
     "default": {
 
       "setup_file": "setup",
 
       "setup_file": "setup",
 
       "json_url": "/json",
 
       "json_url": "/json",
 
-      "port": 8080,
 
-      "approach": "Realistic",
 
-      "classification": "Fullstack",
 
-      "database": "None",
 
-      "framework": "kelp",
 
-      "language": "Perl",
 
-      "orm": "Full",
 
-      "platform": "Plack",
 
-      "webserver": "Starman",
 
-      "os": "Linux",
 
-      "database_os": "Linux",
 
-      "display_name": "kelp",
 
-      "notes": "",
 
-      "versus": ""
 
-    },
 
-    "raw": {
 
-      "setup_file": "setup",
 
       "db_url": "/db",
 
       "db_url": "/db",
 
-      "query_url": "/db?queries=",
 
+      "query_url": "/queries?queries=",
 
+      "fortune_url": "/fortune",
 
+      "update_url": "/update?queries=",
 
+      "plaintext_url": "/plaintext",
 
       "port": 8080,
 
       "port": 8080,
 
       "approach": "Realistic",
 
       "approach": "Realistic",
 
       "classification": "Fullstack",
 
       "classification": "Fullstack",
 
       "database": "MySQL",
 
       "database": "MySQL",
 
       "framework": "kelp",
 
       "framework": "kelp",
 
       "language": "Perl",
 
       "language": "Perl",
 
-      "orm": "Raw",
 
+      "orm": "Full",
 
       "platform": "Plack",
 
       "platform": "Plack",
 
       "webserver": "Starman",
 
       "webserver": "Starman",
 
       "os": "Linux",
 
       "os": "Linux",
 
@@ -39,4 +25,4 @@
 
       "versus": ""
 
       "versus": ""
 
     }
 
     }
 
   }]
 
   }]
 
-}
 
+}

+ 1 - 1
kelp/conf/config.pl
View File 

@@ -1,3 +1,3 @@
 
 {
 
 {
 
-    modules => ['JSON::XS']
 
+    modules    => ['JSON::XS', 'Template'],
 
 }
 
 }

+ 10 - 0
kelp/views/fortunes.tt
View File 

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