[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; |
---|
[8c96802] | 9 | use LWP::UserAgent; |
---|
[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 | |
---|
[8c96802] | 36 | my $ua = LWP::UserAgent->new( |
---|
| 37 | ssl_opts => { verify_hostname => 0 }, |
---|
| 38 | ); |
---|
[560dfd2] | 39 | my $transfer = 0; |
---|
[512faed] | 40 | my $pm = Parallel::ForkManager->new($concurrency); |
---|
[560dfd2] | 41 | $pm->run_on_finish( |
---|
| 42 | sub { |
---|
| 43 | my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $dataref) = @_; |
---|
| 44 | if (defined $dataref) { |
---|
| 45 | $transfer += $$dataref; |
---|
| 46 | } |
---|
[d6dd05b] | 47 | } |
---|
[560dfd2] | 48 | ); |
---|
| 49 | |
---|
| 50 | my ($startsec, $startmicro) = gettimeofday(); |
---|
[45d3453] | 51 | for (my $child = 0; $child < $concurrency; $child++) { |
---|
[560dfd2] | 52 | use bytes; |
---|
[45d3453] | 53 | if ($pm->start) { |
---|
| 54 | # parent |
---|
| 55 | warn "forks $child/$concurrency child ...\n"; |
---|
| 56 | } |
---|
| 57 | else { |
---|
| 58 | # child |
---|
| 59 | my $transfer = 0; |
---|
| 60 | for (my $i = 0; $i < $loops; $i++) { |
---|
| 61 | print STDERR "processing $i/$loops loop\r"; |
---|
| 62 | foreach my $url (@urls) { |
---|
| 63 | my $res = $ua->get($url); |
---|
| 64 | if ($res->is_success) { |
---|
| 65 | $transfer += length($res->content); |
---|
[560dfd2] | 66 | } |
---|
[45d3453] | 67 | else { |
---|
| 68 | print STDERR "\nfail: $url"; |
---|
| 69 | } |
---|
| 70 | sleep($wait); |
---|
[560dfd2] | 71 | } |
---|
[45d3453] | 72 | } |
---|
[560dfd2] | 73 | $pm->finish(0, \$transfer); |
---|
| 74 | } |
---|
[512faed] | 75 | } |
---|
[45d3453] | 76 | $pm->wait_all_children; |
---|
[560dfd2] | 77 | my ($endsec, $endmicro) = gettimeofday(); |
---|
| 78 | my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6; |
---|
| 79 | my $bytepersec = $transfer / $elapsed; |
---|
[512faed] | 80 | |
---|
[560dfd2] | 81 | my @units = qw( B/s KiB/s MiB/s GiB/s ); |
---|
| 82 | my $unit = 0; |
---|
| 83 | while ($bytepersec > 1024) { |
---|
| 84 | $bytepersec /= 1024; |
---|
| 85 | $unit++; |
---|
| 86 | } |
---|
| 87 | $bytepersec = sprintf("%.4g", $bytepersec); |
---|
[512faed] | 88 | |
---|
[560dfd2] | 89 | warn "\n ...done.\n"; |
---|
| 90 | warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n"; |
---|
[512faed] | 91 | |
---|
| 92 | sub usage { |
---|
| 93 | warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n", |
---|
| 94 | " OR...\n", |
---|
| 95 | "$0 url1 url2\n" |
---|
| 96 | ; |
---|
| 97 | |
---|
| 98 | exit; |
---|
| 99 | } |
---|
| 100 | |
---|
| 101 | sub file2urls { |
---|
| 102 | my $file = shift; |
---|
| 103 | |
---|
| 104 | open my $fh, '<', $file or die "$file: $!"; |
---|
| 105 | |
---|
| 106 | my(@urls, $url); |
---|
| 107 | while ($url = <$fh>) { |
---|
| 108 | chomp $url; |
---|
| 109 | push @urls, $url; |
---|
| 110 | } |
---|
| 111 | |
---|
| 112 | return @urls; |
---|
| 113 | } |
---|