#!/usr/bin/perl
# -*- perl -*-

$| = 1;

chdir "/home/web/djgpp" || die;

$found = 0;
$notfound = 0;

use GDBM_File;
tie %GC, 'GDBM_File', "/tmp/djgpp-mirror-cache", &GDBM_WRCREAT, 0640;

if ( -f "mirrors.txt") {
    open(S, "mirrors.txt");
    while (<S>) {
	($url, $junk, $name) = m@((ftp|http|https|rsync)://\S+)\s+(.*\S)\s*@;
	next unless $url =~ /(ftp|http|https|rsync):/;
	$url .= "/" unless $url =~ m@/$@;
	push(@urls, $url);
	push(@names, $name);
    }
    close(S);
} else {
    print "No file mirrors.txt?\n";
}

$now = time();
$cutoff = $now - 3 * 24 * 60 * 60;

for ($i=0; $i<=$#urls; $i++) {
    $name = $names[$i];
    $url = $urls[$i];

    if ($url =~ m@ftp.delorie.com@) {
	# our ftp doesn't work from inside the firewall because of PASV.
	$when = $ts = $now;
	$type = "full";
    } else {
	$last_try = $when = $ts = 0;
	if ($GC{$url}) {
	    ($last_try, $when, $ts, $type) = split(' ', $GC{$url});
	}
	if ($when < $now - 24*60*60) {
	    $type = "";
	    ($newts,$type) = split(' ', &urlget("${url}mirror.ts"));
	    $newts += 0;
	    if ($newts > 0) {
		$when = $now;
		$ts = $newts;
	    }
	}
    }

    $GC{$url} = "$now $when $ts $type";

    if ($last_try - $when > 3*24*60*60) {
	printf("DEAD %s  %s\n", &age($when), $url);
	$notfound ++;
	$inc .= "<!-- dead: $url -->\n";
    } elsif ($ts < $cutoff) {
	printf("BAD  %s  %s\n", &age($ts), $url);
	$notfound ++;
	$inc .= "<!-- failed: $url -->\n";
    } else {
	printf("OK   %s  %s  $type\n", &age($ts), $url);
	if ($type eq "full") {
	    $typestring = " (Full)";
	    $datstring = "full";
	} elsif ($type eq "current") {
	    $typestring = " (Current)";
	    $datstring = "current";
	} else {
	    $typestring = "";
	    $datstring = "current";
	}
	$inc .= sprintf "<tr><td><a href=\"%s\">%s</a></td><td>%s$typestring</td></tr>\n", $url, $url, $name;
	$dat .= "$url\t$datstring\t$name\n";
	$found ++;
    }
}

sub age {
    my ($ts) = @_;
    my ($hours, $days, $rv);
    return "never" if $ts == 0;
    $hours = $now - $ts;
    $hours = int ($hours / 3600 + 0.5);
    $days = int($hours / 24);
    $hours -= $days * 24;
    if ($days > 0) {
	$rv = "$days+$hours";
    } else {
	$rv = $hours;
    }
    return sprintf("%5s", $rv);
}

print "$found ok, $notfound bad.\n";
if ($found > 3 && $found > 0.4 * ($found+$notfound)) {
    print "Results saved\n";
    open(INC, ">getting.inc");
    print INC $inc;
    close(INC);
    open(INC, ">getting.dat");
    print INC $dat;
    close(INC);
} else {
    print "Not doing the Update.\n";
}

untie %GC;

#-----------------------------------------------------------------------------

sub urlget {
    my ($url,$cache) = @_;
    my $rv = '';

    if ($url =~ m@rsync://([^/]+)/(.*)@) {
	($host, $path) = ($1, $2);
	unlink "/tmp/cm.rs.tmp.$$";
	system "rsync ${host}::$path /tmp/cm.rs.tmp.$$ > /dev/null 2>&1";
	open (CM, "/tmp/cm.rs.tmp.$$");
	$rv = join('', <CM>);
	close (CM);
	unlink "/tmp/cm.rs.tmp.$$";
	return $rv;
    }

    if ( -f $cache && -M $cache < 0.1) {
	open(S, $cache);
	$rv = join('', <S>);
	close(S);
	return $rv;
    }

    if (1) {
	open(WGET, "wget --passive-ftp -U djgpp-verifier -q -O - $url |");
	while (<WGET>) {
	    $rv .= $_;
	}
	close(WGET);
	$rv =~ s/[\r\n]+$//;
    } else {
	$rv = '';
    }

    if ($cache && $rv) {
	open(S, "> $cache");
	print S $rv;
	close(S);
    }
    return $rv;
}