Skip to content

Instantly share code, notes, and snippets.

@ab5tract
Last active September 16, 2016 12:17
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ab5tract/ce9b7045dcb5e0c2c215883d2688b479 to your computer and use it in GitHub Desktop.
Save ab5tract/ce9b7045dcb5e0c2c215883d2688b479 to your computer and use it in GitHub Desktop.
Test all the P6 user agents
#!/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";
}
@ab5tract
Copy link
Author

Updated to use the working version of Net::HTTP.

Which unfortunately seems to suffer the same fate as the other Pure Perl modules :(

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment