fetch_sf_mirrors.pl

Last change: 2008-02-03 This is the source code of KCeasy。

#!/usr/bin/perl
use LWP::UserAgent;
use URI::URL;
use HTML::TableExtract;

###########################################################
#
# Reads sf download url and print all available mirrors.
#
###########################################################

if (scalar @ARGV != 1) {
  print "Syntax: $0 <sf download url>\n";
  exit 0;
}

my $url = shift(@ARGV);

# fetch url
print STDERR "Fetching $url\n\n";

$ua = new LWP::UserAgent;
$ua->agent("Mozilla/4.0 (compatible; MSIE 5.5; Windows NT)");

$req = new HTTP::Request 'GET' => $url;
$res = $ua->request($req);

if (not $res->is_success)
{
	print STDERR "\tFailed to fetch url\n";
	print STDERR "\tError: " . $res->code . " " . $res->message . "\n";
	exit 0;
}

# parse result

$te = new HTML::TableExtract( headers => [qw(Host Location Continent Download)],
                              keep_html => 1 );
$te->parse($res->content);


print "# sourceforge mirrors\n\@sf_mirrors = (";

# Examine all matching tables
foreach $ts ($te->table_states) {
#	print STDERR "\nurl;mirror\n";	

	foreach $row ($ts->rows) {
		($mirror_url) = @$row[3] =~ /a\s+href\s*=\s*"?(.+?)"?\s*>/i;
		($mirror) = $mirror_url =~ /use_mirror=(.+?)(&.*)*$/i;

		next if ($mirror_url eq "");

#		print STDERR "$mirror_url;$mirror\n";
		print "               \"$mirror\",\n";
	}
}

print ");\n";

print STDERR "\nFinished\n";