attempt to avoid globals, copyright statement, etc.

git-svn-id: svn://tug.org/texlive/trunk@23926 c570f23f-e606-0410-a88d-b1316a301751

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";
+  }
+}