App-SpeedTest

 view release on metacpan or  search on metacpan

speedtest  view on Meta::CPAN

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;

speedtest  view on Meta::CPAN

	$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,
	id      => 0,

speedtest  view on Meta::CPAN

	$url = $data;
	}
    }
else {
    if ($opt_c) {
	$opt_c = uc $opt_c;
	}
    elsif ($opt_g) {	# Try GeoIP
	$opt_v > 5 and say STDERR "Testing Geo location";
	my $url = "http://www.geoiptool.com";
	my $rsp = $ua->request (HTTP::Request->new (GET => $url));
	if ($rsp->is_success) {
	    my $tree = HTML::TreeBuilder->new ();
	    if ($tree->parse_content ($rsp->content)) {
		foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) {
		    $opt_v > 2 and say STDERR $e->as_text;
		    $e->as_text =~ m{Country code(?:\s*:)?\s*([A-Za-z]+)}i or next;
		    $opt_c = uc $1;
		    last;
		    }
		}

speedtest  view on Meta::CPAN

    my $dl = "-";
    if ($opt_d) {
	$opt_v and print STDERR "Test download ";
	# http://ookla.extraip.net/speedtest/random350x350.jpg
	my @url = @{$host->{dl_list} // [
	    map { ("$base/random${_}x${_}.jpg") x 4 }
	    350, 500, 750, 1000, 1500, 2000, 2500, 3000, 3500, 4000 ]};
	my @rslt;
	$opt_q and splice @url, $opt_q;
	foreach my $url (@url) {
	    my $req = HTTP::Request->new (GET => $url);
	    my $t0 = [ gettimeofday ];
	    my $rsp = $ua->request ($req);
	    my $elapsed = tv_interval ($t0);
	    unless ($rsp->is_success) {
		warn "$url: ", $rsp->status_line, "\n";
		next;
		}
	    my $sz = length $rsp->content;
	    my $speed = 8 * $sz / $elapsed / $k / $k;
	    push @rslt, [ $sz, $elapsed, $speed ];

speedtest  view on Meta::CPAN

	my $data = join "" => map { $data[int rand $#data] } 0 .. 4192;
	$data = "content1=".($data x 8192); # Total length just over 4 Mb
	my @rslt;
	my $url  = $host->{url}; # .php, .asp, .aspx, .jsp
	# see $upld->{mintestsize} and $upld->{maxchunksize} ?
	my @size = map { $_ * 1000 }
	  # ((256) x 10, (512) x 10, (1024) x 10, (4096) x 10);
	    ((256) x 10, (512) x 10, (1024) x 5, (2048) x 5, (4096) x 5, (8192) x 5);
	$opt_q and splice @size, $opt_q;
	foreach my $sz (@size) {
	    my $req = HTTP::Request->new (POST => $url);
	    $req->content (substr $data, 0, $sz);
	    my $t0 = [ gettimeofday ];
	    my $rsp = $ua->request ($req);
	    my $elapsed = tv_interval ($t0);
	    unless ($rsp->is_success) {
		warn "$url: ", $rsp->status_line, "\n";
		next;
		}
	    my $speed = 8 * $sz / $elapsed / $k / $k;
	    push @rslt, [ $sz, $elapsed, $speed ];

speedtest  view on Meta::CPAN

	$opt_v > 1        and printf " Transfer %10.3f kb in %9.3f s. [%8.3f - %8.3f]\n",
	    $size / 1024, $time, $slow, $fast;
	}
    return $sp;
    } # result

### ############################################################################

sub get_config {
    my $url = "http://www.speedtest.net/speedtest-config.php";
    my $rsp = $ua->request (HTTP::Request->new (GET => $url));
    $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n";
    my $xml = XMLin ( $rsp->content,
        keeproot        => 1,
        noattr          => 0,
        keyattr         => [ ],
        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   => "",
        );

speedtest  view on Meta::CPAN

	@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);