瀏覽代碼

Fixed FAILs for query tests

Nate Brady 9 年之前
父節點
當前提交
1234803b3d
共有 2 個文件被更改,包括 16 次插入5 次删除
  1. 15 4
      frameworks/Perl/web-simple/app.pl
  2. 1 1
      frameworks/Perl/web-simple/benchmark_config.json

+ 15 - 4
frameworks/Perl/web-simple/app.pl

@@ -3,7 +3,7 @@ use Web::Simple;
 use JSON::XS;
 use DBI;
 
-my $dsn = "dbi:mysql:database=hello_world;host=localhost";
+my $dsn = "dbi:mysql:database=hello_world;host=127.0.0.1";
 my $dbh = DBI->connect( $dsn, 'benchmarkdbuser', 'benchmarkdbpass', { RaiseError => 1 });
 my $sth = $dbh->prepare('SELECT * FROM World where id = ?');
 
@@ -12,9 +12,20 @@ sub dispatch_request {
     [ 200, [ 'Content-type' => 'application/json', ],
       [ encode_json({ message => 'Hello, World!' }) ] ];
   },
-  sub (/db + ?queries~) {
+  sub (/db) {
+    my $id = int(rand 10000) + 1;
+    my $rand;
+    $sth->execute($id);
+    $sth->bind_col(2, \$rand);
+    if ( my @row = $sth->fetch ) {
+       [ 200, [ 'Content-type' => 'application/json', ], [ encode_json({ id => $id, randomNumber => $rand })] ];
+    }
+  },
+  sub (/query + ?queries~) {
     my ($self, $queries) = @_;
-    $queries ||= 1;
+    $queries //= 1;
+    $queries = 1 if ( $queries !~ /^\d+$/ || $queries < 1 );
+    $queries = 500 if $queries > 500;
     my $rand;
     my @response;
     if ($queries == 1) {
@@ -23,7 +34,7 @@ sub dispatch_request {
         $sth->bind_col(2, \$rand);
         if ( my @row = $sth->fetch ) {
             [ 200, [ 'Content-type' => 'application/json', ], 
-              [ encode_json({ id => $id, randomNumber => $rand })] ];
+              [ encode_json([{ id => $id, randomNumber => $rand }])] ];
         }
     }
     else {

+ 1 - 1
frameworks/Perl/web-simple/benchmark_config.json

@@ -22,7 +22,7 @@
     "raw": {
       "setup_file": "setup",
       "db_url": "/db",
-      "query_url": "/db?queries=",
+      "query_url": "/query?queries=",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Micro",