#! /usr/bin/perl -w

use strict ;

my $login = getpwuid $< ;
die "can't find your login" unless $login ;

my $DEF_CNF = 'mirmon/mirmon.conf' ;
my $me   = "$login\@apache.org" ;
my $SMAIL = '/usr/sbin/sendmail' ;

use lib 'mirmon' ; # Mirmon.pm lives in subdir mirmon.

use Mirmon ;

my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-t] [-f] [-c conf] [-nocc] nag-file
option v    : be verbose
option q    : be quiet
option t    : test send to $me
option f    : send the mails to the contacts
option c    : configuration file ; default search : ( $DEF_CNF )
option nocc : don't cc apmirror\@a.o in nag-mails
-------------------------------------------------------------------
-- first, use no options ; nag just shows the template and
   what it would do

-- second, use -t : it sends some mail (only two), to yourself ;
   the real "To: some contact" is replaced by

     X-To: some contact
     To: yourself

   So you can see what actually would be sent if you
   look at the mail's headers.

-- If you think it looks right, use -f : send the mails.
-------------------------------------------------------------------
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' ) ;
my %opt = () ;
Usage '' unless GetOptions ( \%opt, qw(v q c=s t f nocc) ) ;
Usage "Arg count\n" unless @ARGV == 1 ;

if ( $opt{version} ) { printf "%s\n", Base::version () ; exit ; }

Error "use either -t or -f" if $opt{t} and $opt{f} ;

$opt{v} ||= $opt{d} ;
$opt{c} ||= $DEF_CNF ;

my $ARG = $ARGV [ 0 ] ; 
Error "can't find file $ARG" unless -f $ARG ;

Mirmon::verbose ( $opt{v} ) ;
Mirmon::debug   ( $opt{d} ) ;
Mirmon::quiet   ( $opt{q} ) ;

my $M = Mirmon -> new ( $opt{c} ) ;

my $conf  = $M -> conf  ;
my $state = $M -> state ;
my %mirrs = () ;

my $to = "To: %MAIL%" ;
$to = "X-$to\nTo: $me" if $opt{t} ;
my $cc = "Cc: apmirror\@apache.org" ;
$cc = "X-$cc" if $opt{t} ;

my $templ = <<MAIL ;
From: apmirror\@apache.org
Sender: <$login\@apache.org>
Subject: %URL1% - your apache mirror
Reply-To: apmirror\@apache.org
MAIL

$templ .= "$to\n" ;
$templ .= "$cc\n" unless $opt{nocc} ;
$templ .= "\n" ;

while ( <> )
  { chomp ;
    s/ .*$//; # remove trailing comments
    last if /-------------/ ;
    next if /^#/ or /^\s*$/ ;
    unless ( exists $state -> { $_ } )
      { Warn "mirror not found ($_)" ; }
    else
      { $mirrs { $_ } = $state -> { $_ } ; }
  }

$templ .= join '', <> ;

printf "%s\n", $templ ;

my %urls = () ;

for my $mirr ( values %mirrs )
  { my $mail = $mirr -> mail ;
    my $url  = $mirr -> url ;
    Error "no mail for $url" unless $mail ;
    push @{ $urls { $mail } }, $url ;
  }

my $cnt = 0 ;

for my $MAIL ( sort keys %urls )
  { my @urls = @{ $urls { $MAIL } } ;
    my $URL1 = $urls [ 0 ] ;
    my $URLS = join "\n    ", @urls ;
    my $tmp  = $templ ;
    $tmp =~ s/%MAIL%/$MAIL/g ;
    $tmp =~ s/%URLS%/$URLS/g ;
    $tmp =~ s/%URL1%/$URL1/g ;
    printf "%s mail to '%s'\n"
      , ( $opt{t}
	? 'WOULD send'
	: ( $opt{f} ? 'DID send' : 'NOT sent' )
	)
      , $MAIL
      ;
    print "-------------------------\n" ;

    if ( $opt{t} or $opt{f} )
      { next if $opt{t} and ++ $cnt > 2 ;
	open SMAIL, "| $SMAIL -fapmirror\@apache.org -t" or Error "can't popen $SMAIL ($!)" ;
	print SMAIL $tmp ;
	close $SMAIL ;
      }
    else
      { print "$tmp\n" ;
	print "-------------------------\n" ;
      }
  }