summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/tl-update-ctan-mirrors
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2011-09-13 00:13:07 +0000
committerKarl Berry <karl@freefriends.org>2011-09-13 00:13:07 +0000
commit7f8814d7deee8ef7208c9757d6f1c07bf6e85388 (patch)
tree8dfe232b911487dcfa718923b9ea240782484024 /Master/tlpkg/bin/tl-update-ctan-mirrors
parent24579180da51beb0b66f8014929adcc247b8f945 (diff)
attempt to avoid globals, copyright statement, etc.
git-svn-id: svn://tug.org/texlive/trunk@23926 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/bin/tl-update-ctan-mirrors')
-rwxr-xr-xMaster/tlpkg/bin/tl-update-ctan-mirrors108
1 files changed, 63 insertions, 45 deletions
diff --git a/Master/tlpkg/bin/tl-update-ctan-mirrors b/Master/tlpkg/bin/tl-update-ctan-mirrors
index a7404222337..dab267967ba 100755
--- a/Master/tlpkg/bin/tl-update-ctan-mirrors
+++ b/Master/tlpkg/bin/tl-update-ctan-mirrors
@@ -1,6 +1,11 @@
-#!/usr/bin/perl
-
-# needed file:
+#!/usr/bin/env perl
+# $Id$
+# Copyright 2011 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# Write parsable list of active CTAN mirrors; run from tl-update-auto cron.
+# Needed input:
# http://ctan.org/mirrors (CTAN.sites, README.mirrors)
# rsync://comedy.dante.de/MirMon/mirmon.state
@@ -8,28 +13,33 @@ 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]: $!");
+exit (&main ());
-my %good_urls;
+sub main {
+ if (@ARGV != 2) {
+ die "Usage: $0 CTAN_SITES MIRMON_STATE.\n";
+ }
-read_mstate();
-my %foo = read_readme_mirror();
-$Data::Dumper::Indent = 1;
-print Data::Dumper->Dump([\%foo], [qw(mirrors)]);
+ my %good_urls = read_mstate($ARGV[1]);
+ my %ctan_sites = read_readme_mirror($ARGV[0], \%good_urls);
+ $Data::Dumper::Indent = 1;
+ print Data::Dumper->Dump([\%ctan_sites], [qw(mirrors)]);
+
+ return 0;
+}
+#
+# Return hash of good and bad urls from mirmon state data.
+#
sub read_mstate {
- my %mstate;
+ my ($MSTATE) = @_;
+ my %good_urls;
+
+ open (MSTATE, "<$MSTATE") || die "$0: open($MSTATE) failed: $!\n";
while (<MSTATE>) {
my ($m, $age, $status_last_probe, $time_last_succesful_probe,
- $probe_history, $state_history, $last_probe) = split ' ';
+ $probe_history, $state_history, $last_probe)
+ = split (' ');
if ($status_last_probe eq "ok") {
$good_urls{$m} = 1;
} else {
@@ -37,36 +47,27 @@ sub read_mstate {
}
}
close(MSTATE);
+
+ return %good_urls;
}
-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";
- }
-}
-
+#
+# return hash of CTAN.sites info.
+#
sub read_readme_mirror {
+ my ($CTAN_SITES,$good_urls_ref) = @_;
my %mirrors;
- my $continent;
- my $mirror;
- my $country;
- my %protocols;
- while (<FOO>) {
+ my ($continent, $country, $mirror, %protocols);
+
+ open (CTAN_SITES,"<$CTAN_SITES") || die "$0: open($CTAN_SITES) failed: $!\n";
+ while (<CTAN_SITES>) {
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});
+ add_mirror(\%mirrors,$continent,$country,$mirror,$p,$protocols{$p},
+ $good_urls_ref);
}
}
$continent = $save_continent;
@@ -75,7 +76,8 @@ sub read_readme_mirror {
%protocols = ();
next;
}
- next if (!defined($continent));
+ next if ! defined $continent;
+
if (m/^ ([-a-zA-Z0-9.]+) \((.*)\)\s*$/) {
my $save_mirror = $1;
my $save_country = $2;
@@ -83,7 +85,8 @@ sub read_readme_mirror {
$save_country =~ s/^The //;
if (defined($mirror)) {
for my $p (keys %protocols) {
- add_mirror(\%mirrors, $continent, $country, $mirror, $p, $protocols{$p});
+ add_mirror(\%mirrors,$continent,$country,$mirror,$p,$protocols{$p},
+ $good_urls_ref);
}
}
$mirror = $save_mirror;
@@ -91,7 +94,8 @@ sub read_readme_mirror {
%protocols = ();
next;
}
- next if (!defined($mirror));
+ next if ! defined($mirror);
+
if (m!^ URL: (ftp|http|rsync)://([-a-zA-Z0-9.]+)/([-\w/]*)!) {
$protocols{$1} = "$2/$3";
next;
@@ -100,5 +104,19 @@ sub read_readme_mirror {
}
return %mirrors;
}
-
-
+
+
+sub add_mirror {
+ my ($mirref,$continent,$country,$mirror,$p,$ppath,$good_urls_ref) = @_;
+ my $url = "$p://$ppath";
+ if (exists $good_urls_ref->{$url}) {
+ if ($good_urls_ref->{$url}) {
+ #$mirref->{$continent}{$country}{$mirror}{'protocols_path'}{$p} = $ppath;
+ $mirref->{$continent}{$country}{$url} = 1;
+ } else {
+ printf STDERR "$0: mirror seems to be dead, skipped: $url\n";
+ }
+ } else {
+ printf STDERR "$0: mirror not in mirmon file, skipped: $url\n";
+ }
+}