#!/afs/athena/contrib/perl5/p -w

use FileHandle;
use lib '/mit/bert/project/perl5';
use Finger;
use Net::FTP;
use Benchmark;
use strict;

sub user {
  $ENV{'USER'} || $ENV{'LOGNAME'} || getpwuid($<);
}

sub suck {
  my ($host, $path) = split(/:/, shift, 2);
  my ($ftp, $t0, $t1, $get);
  my $sink = new FileHandle ">/dev/null";

  ($host && $path) || return undef;

  $ftp = new Net::FTP $host, @_;
  $ftp || return undef;

  $ftp->login('anonymous', '-' . user . '@mit.edu')
    || ($ftp->quit, return undef);

  $t0 = new Benchmark;
  { no strict;
    $get = $ftp->get($path, $sink)			# 1
      && $ftp->get($path, $sink)			# 2
	&& $ftp->get($path, $sink)			# 3
	  && $ftp->get($path, $sink)			# 4
	    && $ftp->get($path, $sink)			# 5
	      && $ftp->get($path, $sink)		# 6
		&& $ftp->get($path, $sink)		# 7
		  && $ftp->get($path, $sink)		# 8
		    && $ftp->get($path, $sink)		# 9
		      && $ftp->get($path, $sink);	# 10
  }
  $t1 = new Benchmark;

  $ftp->quit;
  $get ? (timediff($t1, $t0))->[0] / 10 : undef;
}

sub sites {
  my($list, $location, $file) = @_;
  my($fh, $mstate, %mirror, @data, $i);

  if (ref($list) eq 'ARRAY') {
    $fh = Finger::query(@$list);
  } else {
    $fh = new FileHandle;
    open($fh, $list);
  }

 LINE:
  while (<$fh>) {
    /^Known partial mirror/ && ( $mstate='partial', next LINE );
    /^Known mirror/         && ( $mstate='full', next LINE );

    /$location/ || next LINE;

    chop;
    @data = split(/\s+/);
    $mirror{$data[1] . ':' . $data[$#data]} = $mstate;
  }

  %mirror;
}


sub defcmp {
  defined($_[0])
    ? ( defined($_[1]) ? ($_[0] <=> $_[1]) : -1 )
      : ( defined($_[1]) ?              1  :  0 );
}

sub pathconcat {
  my $path = shift;
  local ($_);
 FRAGMENT:
  foreach (@_) {
    $path =~ s@/+$@@;
    m@^/@ || ( $path .= '/' . $_,  next FRAGMENT );
    ($path =~ s@:.*$@:$_@) || ($path = $_);
  }
  $path;
}

sub compare {
  my ($path, %mirror) = @_;
  my ($i, %time);

  foreach $i (keys %mirror) {
    $time{$i} = suck(pathconcat($i, $path),
		     Timeout => 10);
  }

  my %tag = ('full' => ' ',  'partial' => '*');

  my @sm = sort {defcmp($time{$a}, $time{$b})} keys %mirror;
#  printf "%1.1s %-40s -> %s\n", '
  foreach $i (@sm) {
    printf "%1.1s %-40s -> %s\n", ($tag{$mirror{$i}} || '?'),
				  $i, ($time{$i} || 'inacessible');
  }
}

compare( 'CTAN.sites', sites(['ctan@ftp.tex.ac.uk'], 'USA') );