diff options
Diffstat (limited to 'Master/tlpkg/bin/tl-update-ctan-mirrors')
-rwxr-xr-x | Master/tlpkg/bin/tl-update-ctan-mirrors | 104 |
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; +} + + |