#!/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;
}