summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/tl-update-ctan-mirrors
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2011-09-12 23:55:56 +0000
committerKarl Berry <karl@freefriends.org>2011-09-12 23:55:56 +0000
commit24579180da51beb0b66f8014929adcc247b8f945 (patch)
treedf4905e8c4e03ac4b2052abe5031e9dcdb7c1d2f /Master/tlpkg/bin/tl-update-ctan-mirrors
parentec101e315bca605deccdc06127781caf969e9050 (diff)
first attempt at ctan mirror extraction
git-svn-id: svn://tug.org/texlive/trunk@23925 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/bin/tl-update-ctan-mirrors')
-rwxr-xr-xMaster/tlpkg/bin/tl-update-ctan-mirrors104
1 files changed, 104 insertions, 0 deletions
diff --git a/Master/tlpkg/bin/tl-update-ctan-mirrors b/Master/tlpkg/bin/tl-update-ctan-mirrors
new file mode 100755
index 00000000000..a7404222337
--- /dev/null
+++ b/Master/tlpkg/bin/tl-update-ctan-mirrors
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+# needed file:
+# http://ctan.org/mirrors (CTAN.sites, README.mirrors)
+# rsync://comedy.dante.de/MirMon/mirmon.state
+
+use strict;
+$^W = 1;
+use Data::Dumper;
+
+if (!defined($ARGV[0])) {
+ die ("Need the location of README.mirror as argument\n");
+}
+if (!defined($ARGV[1])) {
+ die ("Need the location of mirmon.state file as argument\n");
+}
+
+open FOO, "<$ARGV[0]" || die("Cannot open $ARGV[0]: $!");
+open MSTATE, "<$ARGV[1]" || die("Cannot open $ARGV[1]: $!");
+
+my %good_urls;
+
+read_mstate();
+my %foo = read_readme_mirror();
+$Data::Dumper::Indent = 1;
+print Data::Dumper->Dump([\%foo], [qw(mirrors)]);
+
+sub read_mstate {
+ my %mstate;
+ while (<MSTATE>) {
+ my ($m, $age, $status_last_probe, $time_last_succesful_probe,
+ $probe_history, $state_history, $last_probe) = split ' ';
+ if ($status_last_probe eq "ok") {
+ $good_urls{$m} = 1;
+ } else {
+ $good_urls{$m} = 0;
+ }
+ }
+ close(MSTATE);
+}
+
+sub add_mirror {
+ my ($mirref, $continent, $country, $mirror, $p, $ppath) = @_;
+ my $url = "$p://$ppath";
+ if (defined($good_urls{$url})) {
+ if ($good_urls{$url}) {
+ #$mirref->{$continent}{$country}{$mirror}{'protocols_path'}{$p} = $ppath;
+ $mirref->{$continent}{$country}{$url} = 1;
+ } else {
+ printf STDERR "mirror seems to be dead, skipped: $url\n";
+ }
+ } else {
+ printf STDERR "mirror not in mirmon file, skipped: $url\n";
+ }
+}
+
+sub read_readme_mirror {
+ my %mirrors;
+ my $continent;
+ my $mirror;
+ my $country;
+ my %protocols;
+ while (<FOO>) {
+ chomp;
+ if (m/^ (Africa|Asia|Australasia|Europe|North America|South America)/) {
+ my $save_continent = $1;
+ if (defined($mirror)) {
+ for my $p (keys %protocols) {
+ add_mirror(\%mirrors, $continent, $country, $mirror, $p, $protocols{$p});
+ }
+ }
+ $continent = $save_continent;
+ $mirror = undef;
+ $country = undef;
+ %protocols = ();
+ next;
+ }
+ next if (!defined($continent));
+ if (m/^ ([-a-zA-Z0-9.]+) \((.*)\)\s*$/) {
+ my $save_mirror = $1;
+ my $save_country = $2;
+ # make country names more reasonable
+ $save_country =~ s/^The //;
+ if (defined($mirror)) {
+ for my $p (keys %protocols) {
+ add_mirror(\%mirrors, $continent, $country, $mirror, $p, $protocols{$p});
+ }
+ }
+ $mirror = $save_mirror;
+ $country = $save_country;
+ %protocols = ();
+ next;
+ }
+ next if (!defined($mirror));
+ if (m!^ URL: (ftp|http|rsync)://([-a-zA-Z0-9.]+)/([-\w/]*)!) {
+ $protocols{$1} = "$2/$3";
+ next;
+ }
+ #print "ignored >>$_<<\n";
+ }
+ return %mirrors;
+}
+
+