view release on metacpan or  search on metacpan

speedtest  view on Meta::CPAN

    "Q|realquick:10"	=>    \$opt_q,
    "U|skip-undef!"	=> \my $opt_U,

    "m|mini=s"		=> \my $mini,
      "source=s"	=> \my $source,	# NYI
    ) or usage (1);

$opt_CNL and $opt_C++;
$opt_C || $opt_P and $opt_v = 0;

use LWP::UserAgent;
use XML::Simple; # Can safely be replaced with XML::LibXML::Simple
use HTML::TreeBuilder;
use Term::ANSIColor;
use Time::HiRes qw( gettimeofday tv_interval );
use List::Util  qw( first sum );
use Socket      qw( inet_ntoa );
use Math::Trig;

sub pod_text {
    require Pod::Text::Color;
    my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color";
    my $p = $m->new ();
    open my $fh, ">", \my $out;
    $p->parse_from_file ($0, $fh);
    close $fh;
    print $out;
    exit 0;
    } # pod_text

sub pod_nroff {
    first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();

    require Pod::Man;
    my $p = Pod::Man->new ();
    open my $fh, "|-", "nroff", "-man";
    $p->parse_from_file ($0, $fh);
    close $fh;
    exit 0;
    } # pod_nroff

# Debugging. Prefer Data::Peek over Data::Dumper if available
{   use Data::Dumper;
    my $dp = eval { require Data::Peek; 1; };
    sub ddumper {
	$dp ? Data::Peek::DDumper (@_)
	    : print STDERR Dumper (@_);
	} # ddumper
    }

$timeout ||= 10;
my $ua = LWP::UserAgent->new (
    max_redirect => 2,
    agent        => "speedtest/$VERSION",
    parse_head   => 0,
    timeout      => $timeout,
    cookie_jar   => {},
    );
$ua->env_proxy;

binmode STDOUT, ":encoding(utf-8)";

# Speedtest.net defines Mbit/s and kbit/s using 1000 as multiplier,
# https://support.speedtest.net/entries/21057567-What-do-mbps-and-kbps-mean-
my $k = 1000;

my $config = get_config ();
my $client = $config->{"client"}   or die "Config saw no client\n";
my $times  = $config->{"times"}    or die "Config saw no times\n";
my $downld = $config->{"download"} or die "Config saw no download\n";
my $upld   = $config->{"upload"}   or die "Config saw no upload\n";
$opt_v > 3 and ddumper {
    client => $client,
    times  => $times,
    down   => $downld,
    up     => $upld,
    };

if ($url || $mini) {
    $opt_g   = 0;
    $opt_c   = "";
    @server  = ();
    my $ping    = 0.05;
    my $name    = "";
    my $sponsor = "CLI";
    if ($mini) {
	my $t0  = [ gettimeofday ];
	my $rsp = $ua->request (HTTP::Request->new (GET => $mini));
	$ping   = tv_interval ($t0);
	$rsp->is_success or die $rsp->status_line . "\n";
	my $tree = HTML::TreeBuilder->new ();
	$tree->parse_content ($rsp->content) or die "Cannot parse\n";
	my $ext = "";
	for ($tree->look_down (_tag => "script")) {
	    my $c = ($_->content)[0] or next;
	    ref $c eq "ARRAY" && $c->[0] &&
		$c->[0] =~ m{\b (?: upload_? | config ) Extension
			     \s*: \s* "? ([^"\s]+) }xi or next;
	    $ext = $1;
	    last;
	    }
	$ext or die "No ext found\n";
	($url = $mini) =~ s{/*$}{/speedtest/upload.$ext};
	$sponsor = $_->as_text for $tree->look_down (_tag => "title");
	$name  ||= $_->as_text for $tree->look_down (_tag => "h1");
	$name  ||= "Speedtest mini";
	}
    else {
	$name = "Local";
	$url =~ m{/\w+\.\w+$} or $url =~ s{/?$}{/speedtest/upload.php};
	my $t0  = [ gettimeofday ];
	my $rsp = $ua->request (HTTP::Request->new (GET => $url));
	$ping   = tv_interval ($t0);
	$rsp->is_success or die $rsp->status_line . "\n";
	}
    (my $host = $url) =~ s{^\w+://([^/]+)(?:/.*)?}{$1};
    $url = {
	cc      => "",
	country => "",
	dist    => "0.0",
	host    => $host,