misc/httpbench.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 use Getopt::Long;
   8 use Parallel::ForkManager;
   9 use LWP::Simple;
  10 use Time::HiRes qw(sleep);
  11
  12 GetOptions(
  13     'h|help'            => \ my $help,
  14     'i|inputfile=s'     => \ my $file,
  15     'c|concurrency=i'   => \ my $concurrency,
  16     'n|loops=i'         => \ my $loops,
  17     'w|wait=f'          => \ my $wait,
  18 ) or usage();
  19
  20 usage() if $help;
  21
  22 $concurrency ||= 1;
  23 $loops ||= 1;
  24 $wait ||= 0;
  25
  26 my @urls = file2urls($file) if ($file);
  27 push @urls, @ARGV;
  28
  29 my $num = scalar @urls;
  30 warn "$num urls with $concurrency clients, $loops loops\n";
  31 warn "Total: ", $num * $concurrency * $loops, " requests\n";
  32 warn "wait for $wait second between requests\n";
  33
  34
  35
  36 my $pm = Parallel::ForkManager->new($concurrency);
  37 for (my $child = 0; $child < $concurrency; $child++) {
  38     if ($pm->start) {
  39         warn "forks $child/$concurrency child ...\n";
  40         next;
  41     }
  42         for (my $i = 0; $i < $loops; $i++) {
  43             print STDERR "processing $i/$loops loop\r";
  44             foreach my $url (@urls) {
  45                 get($url) or warn "fail: $url\n";
  46                 sleep($wait);
  47             }
  48         }
  49     $pm->finish;
  50 }
  51 $pm->wait_all_children;
  52
  53 warn "\n ...done.\n";
  54
  55
  56 sub usage {
  57     warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n",
  58          " OR...\n",
  59          "$0 url1 url2\n"
  60     ;
  61
  62     exit;
  63 }
  64
  65 sub file2urls {
  66     my $file = shift;
  67
  68     open my $fh, '<', $file or die "$file: $!";
  69
  70     my(@urls, $url);
  71     while ($url = <$fh>) {
  72         chomp $url;
  73         push @urls, $url;
  74     }
  75
  76     return @urls;
  77 }