From 512faedf38a2f9da3d7d98f4806ea3d42e4db8a3 Mon Sep 17 00:00:00 2001
From: Ken-ichi Mito <mitty@mitty.jp>
Date: Sat, 2 Nov 2013 23:31:34 +0900
Subject: [PATCH] http bench mark client with perl's Parallel::ForkManager

 * $ ./httpbench.pl -i urls.txt -c 10 -n 2 -w 0.2
---
 misc/httpbench.pl |   74 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100755 misc/httpbench.pl

diff --git a/misc/httpbench.pl b/misc/httpbench.pl
new file mode 100755
index 0000000..028c6b6
--- /dev/null
+++ b/misc/httpbench.pl
@@ -0,0 +1,74 @@
+#! /usr/bin/perl -w
+
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Parallel::ForkManager;
+use LWP::Simple;
+use Time::HiRes qw(sleep);
+
+GetOptions(
+    'h|help'            => \ my $help,
+    'i|inputfile=s'     => \ my $file,
+    'c|concurrency=i'   => \ my $concurrency,
+    'n|loops=i'         => \ my $loops,
+    'w|wait=f'          => \ my $wait,
+) or usage();
+
+usage() if $help;
+
+$concurrency ||= 1;
+$loops ||= 1;
+$wait ||= 0;
+
+my @urls = file2urls($file) if ($file);
+push @urls, @ARGV;
+
+my $num = scalar @urls;
+warn "$num urls with $concurrency clients, $loops loops\n";
+warn "Total: ", $num * $concurrency * $loops, " requests\n";
+warn "wait for $wait second between requests\n";
+
+
+
+my $pm = Parallel::ForkManager->new($concurrency);
+for (my $i = 0; $i < $loops; $i++) {
+    for (my $child = 0; $child < $concurrency; $child++) {
+        $pm->start and next;
+            foreach my $url (@urls) {
+                get($url) or warn "fail: $url\n";
+                sleep($wait);
+            }
+        $pm->finish;
+    }
+    print STDERR " ... ", $num * $concurrency * ($i + 1), " requesting\r";
+}
+$pm->wait_all_children;
+
+warn "\n ...done.\n";
+
+
+sub usage {
+    warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n",
+         " OR...\n",
+         "$0 url1 url2\n"
+    ;
+    
+    exit;
+}
+
+sub file2urls {
+    my $file = shift;
+    
+    open my $fh, '<', $file or die "$file: $!";
+    
+    my(@urls, $url);
+    while ($url = <$fh>) {
+        chomp $url;
+        push @urls, $url;
+    }
+    
+    return @urls;
+}
-- 
1.7.9.5