view release on metacpan or  search on metacpan

speedtest  view on Meta::CPAN

    "V|version!"	=> sub { print "$CMD [$VERSION]\n"; exit 0; },
    "v|verbose:2"	=>    \$opt_v,
      "simple!"		=> sub { $opt_v = 0; },
      "man"		=> sub { pod_nroff (); },
      "info"		=> sub { pod_text  (); },

      "all!"		=> \my $opt_a,
    "g|geo!"		=>    \$opt_g,
    "c|cc|country=s"	=>    \$opt_c,
      "list-cc!"	=> \my $opt_cc,
    "1|one-line!"	=> \my $opt_1,
    "C|csv!"		=> \my $opt_C,
      "csv-eol-unix|".
      "csv-eol-nl!"	=> \my $opt_CNL,
    "P|prtg!"		=> \my $opt_P,

    "l|list!"		=> \my $list,
    "p|ping:40"		=> \my $opt_ping,
      "url:s"		=> \my $url,
      "ip!"		=> \my $ip,

    "B|bytes"		=> sub { $unit = [ 8, "byte" ] },

    "T|try:5"		=>    \$opt_T,
    "s|server=s"	=> \my @server,
    "t|timeout=i"	=> \my $timeout,
    "d|download!"	=>    \$opt_d,
    "u|upload!"		=>    \$opt_u,
    "q|quick|fast:20"	=>    \$opt_q,
    "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";

speedtest  view on Meta::CPAN

        suppressempty   => "",
        );
    $opt_v > 5 and ddumper $xml->{settings};
    return $xml->{settings};
    } # get_config

sub get_servers {
    my $servlist;
    foreach my $url (qw(
	      http://www.speedtest.net/speedtest-servers-static.php
	      http://www.speedtest.net/speedtest-servers.php
	      http://c.speedtest.net/speedtest-servers.php
	      )) {
	$opt_v > 2 and warn "Fetching $url\n";
	my $rsp = $ua->request (HTTP::Request->new (GET => $url));
	$opt_v > 2 and warn $rsp->status_line, "\n";
	$rsp->is_success and $servlist = $rsp->content and last;
	}
    $servlist or die "Cannot get any config\n";
    my $xml = XMLin ($servlist,
        keeproot        => 1,
        noattr          => 0,
        keyattr         => [ ],
        suppressempty   => "",
        );
    # 4601 => {
    #   cc      => 'NL',
    #   country => 'Netherlands',
    #   dist    => '38.5028663935342602',	# added later
    #   id      => 4601,
    #   lat     => '52.2167',
    #   lon     => '5.9667',
    #   name    => 'Apeldoorn',
    #   sponsor => 'Solcon Internetdiensten N.V.',
    #   url     => 'http://speedtest.solcon.net/speedtest/upload.php',
    #   url2    => 'http://ooklaspeedtest.solcon.net/speedtest/upload.php'
    #   },

    return map { $_->{id} => $_ } @{$xml->{settings}{servers}{server}};
    } # get_servers

sub distance {
    my ($lat_c, $lon_c, $lat_s, $lon_s) = @_;
    my $rad = 6371; # km

    # Convert angles from degrees to radians
    my $dlat = deg2rad ($lat_s - $lat_c);
    my $dlon = deg2rad ($lon_s - $lon_c);

    my $x = sin ($dlat / 2) * sin ($dlat / 2) +
	    cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) *
		sin ($dlon / 2) * sin ($dlon / 2);

    return $rad * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km
    } # distance

sub servers {
    my %list = get_servers ();
    if (my $iid = $config->{"server-config"}{ignoreids}) {
	$opt_v > 3 and warn "Removing servers $iid from server list\n";
	delete @list{split m/\s*,\s*/ => $iid};
	}
    $opt_a or delete @list{grep { $list{$_}{cc} ne $opt_c } keys %list};
    %list or die "No servers in $opt_c found\n";
    for (values %list) {
	$_->{dist} = distance ($client->{lat}, $client->{lon},
	    $_->{lat}, $_->{lon});
	($_->{url0} = $_->{url}) =~ s{/speedtest/upload.*}{};
	$opt_v > 7 and ddumper $_;
	}
    return %list;
    } # servers

sub servers_by_ping {
    my %list = servers;
    my @list = values %list;
    $opt_v > 1 and say STDERR "Finding fastest host out of @{[scalar @list]} hosts for $opt_c ...";
    my $pa = LWP::UserAgent->new (
	max_redirect => 2,
	agent        => "Opera/25.00 opera 25",
	parse_head   => 0,
	cookie_jar   => {},
	timeout      => $timeout,
	);
    $pa->env_proxy;
    $opt_ping ||= 40;
    if (@list > $opt_ping) {
	@list = sort { $a->{dist} <=> $b->{dist} } @list;
	@server or splice @list, $opt_ping;
	}
    foreach my $h (@list) {
	my $t = 0;
	if (@server and not first { $h->{id} == $_ } @server) {
	    $h->{ping} = 999999;
	    next;
	    }
	$opt_v > 5 and printf STDERR "? %4d %-20.20s %s\n",
	    $h->{id}, $h->{sponsor}, $h->{url};
	my $req = HTTP::Request->new (GET => "$h->{url}/latency.txt");
	for (0 .. 3) {
	    my $t0 = [ gettimeofday ];
	    my $rsp = $pa->request ($req);
	    my $elapsed = tv_interval ($t0);
	    $opt_v > 8 and printf STDERR "%4d %9.2f\n", $_, $elapsed;
	    if ($elapsed >= 15) {
		$t = 40;
		last;
		}
	    $t += ($rsp->is_success ? $elapsed : 1000);
	    }
	$h->{ping} = $t * 1000; # report in ms
	}
    sort { $a->{ping} <=> $b->{ping}
        || $a->{dist} <=> $b->{dist} } @list;
    } # servers_by_ping

__END__

=encoding UTF-8

=head1 NAME