1 | #! /usr/bin/perl -w |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | use utf8; |
---|
6 | |
---|
7 | use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat); |
---|
8 | use Parallel::ForkManager; |
---|
9 | use LWP::UserAgent; |
---|
10 | use Time::HiRes qw(sleep gettimeofday); |
---|
11 | |
---|
12 | usage() if (@ARGV == 0); |
---|
13 | |
---|
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"; |
---|
34 | warn "wait for $wait second between requests\n" if ($wait); |
---|
35 | |
---|
36 | my $ua = LWP::UserAgent->new( |
---|
37 | ssl_opts => { verify_hostname => 0 }, |
---|
38 | ); |
---|
39 | my $transfer = 0; |
---|
40 | my $pm = Parallel::ForkManager->new($concurrency); |
---|
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 | } |
---|
47 | } |
---|
48 | ); |
---|
49 | |
---|
50 | my ($startsec, $startmicro) = gettimeofday(); |
---|
51 | { |
---|
52 | use bytes; |
---|
53 | for (my $child = 0; $child < $concurrency; $child++) { |
---|
54 | if ($pm->start) { |
---|
55 | warn "forks $child/$concurrency child ...\n"; |
---|
56 | next; |
---|
57 | } |
---|
58 | my $transfer = 0; |
---|
59 | for (my $i = 0; $i < $loops; $i++) { |
---|
60 | print STDERR "processing $i/$loops loop\r"; |
---|
61 | foreach my $url (@urls) { |
---|
62 | my $res = $ua->get($url); |
---|
63 | if ($res->is_success) { |
---|
64 | $transfer += length($res->content); |
---|
65 | } |
---|
66 | else { |
---|
67 | print STDERR "\nfail: $url"; |
---|
68 | } |
---|
69 | sleep($wait); |
---|
70 | } |
---|
71 | } |
---|
72 | $pm->finish(0, \$transfer); |
---|
73 | } |
---|
74 | $pm->wait_all_children; |
---|
75 | } |
---|
76 | my ($endsec, $endmicro) = gettimeofday(); |
---|
77 | my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6; |
---|
78 | my $bytepersec = $transfer / $elapsed; |
---|
79 | |
---|
80 | my @units = qw( B/s KiB/s MiB/s GiB/s ); |
---|
81 | my $unit = 0; |
---|
82 | while ($bytepersec > 1024) { |
---|
83 | $bytepersec /= 1024; |
---|
84 | $unit++; |
---|
85 | } |
---|
86 | $bytepersec = sprintf("%.4g", $bytepersec); |
---|
87 | |
---|
88 | warn "\n ...done.\n"; |
---|
89 | warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n"; |
---|
90 | |
---|
91 | sub usage { |
---|
92 | warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n", |
---|
93 | " OR...\n", |
---|
94 | "$0 url1 url2\n" |
---|
95 | ; |
---|
96 | |
---|
97 | exit; |
---|
98 | } |
---|
99 | |
---|
100 | sub file2urls { |
---|
101 | my $file = shift; |
---|
102 | |
---|
103 | open my $fh, '<', $file or die "$file: $!"; |
---|
104 | |
---|
105 | my(@urls, $url); |
---|
106 | while ($url = <$fh>) { |
---|
107 | chomp $url; |
---|
108 | push @urls, $url; |
---|
109 | } |
---|
110 | |
---|
111 | return @urls; |
---|
112 | } |
---|