[512faed] | 1 | #! /usr/bin/perl -w |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use utf8; |
---|
| 6 | |
---|
[cff45ef] | 7 | use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat); |
---|
[512faed] | 8 | use Parallel::ForkManager; |
---|
| 9 | use LWP::Simple; |
---|
[560dfd2] | 10 | use Time::HiRes qw(sleep gettimeofday); |
---|
[512faed] | 11 | |
---|
[0035554] | 12 | usage() if (@ARGV == 0); |
---|
| 13 | |
---|
[512faed] | 14 | GetOptions( |
---|
| 15 | 'h|help' => \ my $help, |
---|
| 16 | 'i|inputfile=s' => \ my $file, |
---|
| 17 | 'c|concurrency=i' => \ my $concurrency, |
---|
| 18 | 'n|loops=i' => \ my $loops, |
---|
| 19 | 'w|wait=f' => \ my $wait, |
---|
| 20 | ) or usage(); |
---|
| 21 | |
---|
| 22 | usage() if $help; |
---|
| 23 | |
---|
| 24 | $concurrency ||= 1; |
---|
| 25 | $loops ||= 1; |
---|
| 26 | $wait ||= 0; |
---|
| 27 | |
---|
| 28 | my @urls = file2urls($file) if ($file); |
---|
| 29 | push @urls, @ARGV; |
---|
| 30 | |
---|
| 31 | my $num = scalar @urls; |
---|
| 32 | warn "$num urls with $concurrency clients, $loops loops\n"; |
---|
| 33 | warn "Total: ", $num * $concurrency * $loops, " requests\n"; |
---|
[560dfd2] | 34 | warn "wait for $wait second between requests\n" if ($wait); |
---|
[512faed] | 35 | |
---|
| 36 | |
---|
[560dfd2] | 37 | my $transfer = 0; |
---|
[512faed] | 38 | my $pm = Parallel::ForkManager->new($concurrency); |
---|
[560dfd2] | 39 | $pm->run_on_finish( |
---|
| 40 | sub { |
---|
| 41 | my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $dataref) = @_; |
---|
| 42 | if (defined $dataref) { |
---|
| 43 | $transfer += $$dataref; |
---|
| 44 | } |
---|
[d6dd05b] | 45 | } |
---|
[560dfd2] | 46 | ); |
---|
| 47 | |
---|
| 48 | my ($startsec, $startmicro) = gettimeofday(); |
---|
| 49 | { |
---|
| 50 | use bytes; |
---|
| 51 | for (my $child = 0; $child < $concurrency; $child++) { |
---|
| 52 | if ($pm->start) { |
---|
| 53 | warn "forks $child/$concurrency child ...\n"; |
---|
| 54 | next; |
---|
[d6dd05b] | 55 | } |
---|
[560dfd2] | 56 | my $transfer = 0; |
---|
| 57 | for (my $i = 0; $i < $loops; $i++) { |
---|
| 58 | print STDERR "processing $i/$loops loop\r"; |
---|
| 59 | foreach my $url (@urls) { |
---|
| 60 | my $res = get($url) or print STDERR "\nfail: $url"; |
---|
| 61 | if ($res) { |
---|
| 62 | $transfer += length($res); |
---|
| 63 | } |
---|
| 64 | sleep($wait); |
---|
| 65 | } |
---|
| 66 | } |
---|
| 67 | $pm->finish(0, \$transfer); |
---|
| 68 | } |
---|
| 69 | $pm->wait_all_children; |
---|
[512faed] | 70 | } |
---|
[560dfd2] | 71 | my ($endsec, $endmicro) = gettimeofday(); |
---|
| 72 | my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6; |
---|
| 73 | my $bytepersec = $transfer / $elapsed; |
---|
[512faed] | 74 | |
---|
[560dfd2] | 75 | my @units = qw( B/s KiB/s MiB/s GiB/s ); |
---|
| 76 | my $unit = 0; |
---|
| 77 | while ($bytepersec > 1024) { |
---|
| 78 | $bytepersec /= 1024; |
---|
| 79 | $unit++; |
---|
| 80 | } |
---|
| 81 | $bytepersec = sprintf("%.4g", $bytepersec); |
---|
[512faed] | 82 | |
---|
[560dfd2] | 83 | warn "\n ...done.\n"; |
---|
| 84 | warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n"; |
---|
[512faed] | 85 | |
---|
| 86 | sub usage { |
---|
| 87 | warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n", |
---|
| 88 | " OR...\n", |
---|
| 89 | "$0 url1 url2\n" |
---|
| 90 | ; |
---|
| 91 | |
---|
| 92 | exit; |
---|
| 93 | } |
---|
| 94 | |
---|
| 95 | sub file2urls { |
---|
| 96 | my $file = shift; |
---|
| 97 | |
---|
| 98 | open my $fh, '<', $file or die "$file: $!"; |
---|
| 99 | |
---|
| 100 | my(@urls, $url); |
---|
| 101 | while ($url = <$fh>) { |
---|
| 102 | chomp $url; |
---|
| 103 | push @urls, $url; |
---|
| 104 | } |
---|
| 105 | |
---|
| 106 | return @urls; |
---|
| 107 | } |
---|