From 7f8814d7deee8ef7208c9757d6f1c07bf6e85388 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Tue, 13 Sep 2011 00:13:07 +0000 Subject: attempt to avoid globals, copyright statement, etc. git-svn-id: svn://tug.org/texlive/trunk@23926 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/bin/tl-update-ctan-mirrors | 108 +++++++++++++++++++------------- 1 file changed, 63 insertions(+), 45 deletions(-) (limited to 'Master/tlpkg/bin') 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 () { 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 () { + my ($continent, $country, $mirror, %protocols); + + open (CTAN_SITES,"<$CTAN_SITES") || die "$0: open($CTAN_SITES) failed: $!\n"; + while () { 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"; + } +} -- cgit v1.2.3