#! /usr/bin/perl -w

use strict ;

my $DEF_INP = 'mirrors.list' ;

my %TYPS ; $TYPS { $_ } ++ for qw(ftp http https rsync) ;
my $TYPS = join '|', sort keys %TYPS ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [input [output]]
option v : be verbose
option q : be quiet
-----------------------------------------------
default input  : $DEF_INP
default output : no output ; only errors ; with -v, show list
-----------------------------------------------
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "$prog: $_[0]\n" ; }
sub Warn  { warn "$prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config('no_ignore_case') ;
# Usage() unless GetOptions() ;
my %opt = () ; Usage '' unless GetOptions ( \%opt, qw( v q ) ) ;
Usage("Arg count\n") unless 0 <= @ARGV and @ARGV <= 2 ;

my $INP = shift || $DEF_INP ;
my $OUT = shift ;
my $TMP ;

sub typ { my $url = shift ; ( $url =~ /:/ ) ? $` : '' ; }

open INP, $INP or Error "can't open $INP ($!)" ;

if ( defined $OUT )
  { $TMP = "$OUT.tmp" ;
    open TMP, ">$TMP" or Error "can't write $TMP" ;
  }

my @res = qw() ;
my @errors = qw() ;

while ( <INP> )
  { my @err ;
    chomp ;
    s/\s+$// ;
    next if /^\s*$/ ;
    next if /^#/ ;

    my ( $reg, $url, $mail ) = split ' ' ;

    unless ( defined $url )
      { push @err, 'no url' ; }
    elsif ( $url !~ m!/$! )
      { $url .= '/' ; push @err, "add missing trailing '/'" ; }
    elsif ( $url !~ m!^($TYPS)://! )
      { push @err, 'bad url' ; }
    elsif ( ! exists $TYPS { typ $url } )
      { push @err, 'unknown scheme in url' ; }
    elsif ( $url =~ /^rsync:/ and $url =~ /::/ )
      { push @err, "rsync-urls shouldn't match '::'" ; }

    unless ( defined $mail )
      { push @err, 'no mail' ; }
    elsif ( $mail !~ /@/ )
      { push @err, 'no @ in mail' ; }

    if ( @err )
      { my $line = $_ ; push @errors, map { "$_ :\n  $line" ; } @err ; }
    else
      { push @res, sprintf "%s %s %s\n", $reg, $url, $mail ; }
  }

# check sanity ; > 0 because 'Backup' may be special
Error "not enough mirrors ; bailing out" unless @res > 10 ;

my $res = join '', sort @res ;

if ( $TMP )
  { print TMP $res ;
    close TMP ;
    my $siz = -s $TMP ;
    my $len = length $res ;
    Error "bad size $TMP ($siz) ; should be $len" if $siz != $len ;
    rename $TMP, $OUT or Error "can't mv '$TMP' '$OUT' ($!)" ;
  }
else
  { print $res if $opt{v} ;
    Error sprintf "\n%s", join "\n", @errors if @errors ;
    printf "mirrors : %d ; no errors found\n", scalar @res unless $opt{q} ;
  }