Last active
September 16, 2016 12:17
-
-
Save ab5tract/ce9b7045dcb5e0c2c215883d2688b479 to your computer and use it in GitHub Desktop.
Test all the P6 user agents
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl6 | |
use v6; | |
use HTTP::UserAgent; | |
use LWP::Simple; | |
use Net::Curl; | |
use Net::Curl::Easy; | |
use Net::HTTP::GET; | |
my @agents; | |
my @options = ^1000 .rotor(100); | |
my %fetchers-so-far = :curl, :http-useragent, :lwp, :libcurl, :net-http; | |
subset ValidFetcher where { %fetchers-so-far{$_} }; | |
sub MAIN(:$url = 'http://fys.wtf', :$ua, ValidFetcher :$fetcher = 'curl') { | |
given $fetcher { | |
when 'http-useragent' { | |
@agents = HTTP::UserAgent.new(useragent => $ua || 'hello') xx +@options; | |
} | |
when 'lwp' { | |
@agents = LWP::Simple.new xx +@options; | |
} | |
when 'net-http' { | |
@agents = Net::HTTP::GET xx +@options; | |
} | |
} | |
my $started; | |
my $counted = 0; | |
my $count-supplier = Supplier.new; | |
my $counter = $count-supplier.Supply; | |
$counter.act({ $counted++ }); | |
my sub request(@options) { | |
my $maybe-ua = $ua ?? "-A '$ua'" !! ''; # use the default curl UA if nothing was specified | |
my $found = Promise.new; | |
my @fetchers = do for @options.kv -> $idx, @pins { | |
my $agent := @agents[$idx]; | |
$started += +@pins; | |
start { | |
for @pins -> $pin { | |
my $res; | |
given $fetcher { | |
when 'curl' { | |
$res = qq:x[ curl -s $maybe-ua '$url' ]; | |
} | |
when 'libcurl' { | |
my $curl = Net::Curl::Easy.new(url => $url); | |
$res = $curl.download; | |
} | |
when 'net-http' { | |
$res = $agent.($url); | |
} | |
when 'http-useragent' | 'lwp' { | |
$res = $agent.get($url); | |
} | |
} | |
print $idx; | |
$count-supplier.emit(1); | |
} | |
} | |
} | |
Promise.allof(@fetchers).then({ $found.keep }); | |
return $found; | |
} | |
await request(@options); | |
say "\nstarted:\t$started"; | |
say "arrived:\t$counted"; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Updated to use the working version of Net::HTTP.
Which unfortunately seems to suffer the same fate as the other Pure Perl modules :(