#! /usr/bin/perl -w

use strict ;

use Blib ;
use RF ;

my $REMO = 'cpan-rsync.perl.org::CPAN' ;
my $TST  = 'testenv' ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-c <conf>] [test-directory]
option v : be verbose
option q : be quiet
option d : show debug info
option f : clobber
option c : use config file <conf>
argument : the name of the (to-be-created) test-directory
           default : '$TST'
------------------------------------------------------
$prog : create a test environment for iim
-- it creates a test-directory with subdirs CPAN, sync
-- it creates a test iim.conf
-- it copies RECENT-*.json file from your real CPAN archive
   or it fetches them from $REMO
   if your archive is oldish
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 d f c=s _conf) ) ;
Usage("Arg count\n") unless @ARGV <= 1 ;

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

$TST = shift if @ARGV ;
chop $TST if $TST =~ m!/$! ;
my $ABS = $TST ;
unless ( $ABS =~ m!^/! )
  { my $PWD = `pwd` ; chop $PWD ; $ABS = "$PWD/$ABS" ; }

Blib -> debug ( 0 ) ;

my $R    = RF -> make ( -root => $opt{c} ) ; # or die
my $conf = $R -> conf ;
my $root = $conf -> root ;
my @RFS  = @{ $R -> all_Recents } ;

sub mk_conf
  { my $dir = shift ;
    my $res = <<CONF ;
include $root
local $dir/CPAN
sleep_main_loop 15s
allow_full_syncs 0
CONF
    $res ;
  }

if ( $opt{_conf} )
  { my $conf = mk_conf 'testenv' ;
    chomp $conf ;
    printf "%s\n",  join "\n    ", split /\n/, $conf ;
    exit ;
  }

$R -> verbose ( $opt{v} ) ;
$R -> debug   ( $opt{d} ) ;

my $user = $conf -> user   ;
my $pswd = $conf -> passwd ;
my $locl = $conf -> local  ;
my $remo = $conf -> remote ;

Error "can't find your CPAN archive" unless -d $locl ;

Error "$TST already exists (as a file)" if -f $TST ;
my $opt = '-f' . ( $opt{c} ? " -c $opt{c}" : '' ) ;
Error <<ERR if -d $TST and not $opt{f} ;
directory $TST already exists ;
If it is ok to clobber it, use '-f' as in :

  perl $prog $opt $TST
ERR

Error "looking at your CPAN archive $locl ...\n"
  . "  -> can't find any good RECENT-*.json files"
    unless scalar grep { -f $_ ; } map { "$locl/$_" ; } @RFS ;
my $rf1h = $RFS [ 0 ] ;
my $file = $R -> in_locl ( $rf1h ) ; 
Error "looking at your CPAN archive $locl ...\n"
  . "  -> can't find $rf1h ; is your mirror up-to-date ?" unless $file ;
my $json = $R -> get_json ( $file ) ; 
my $time = int $json -> meta -> Producers -> time ;
my $age  = $^T - $time ;
Error "looking at your CPAN archive $locl ...\n"
  . "  -> your mirror appears to live in the future" if $age < 0 ;

my $old = Blib::Mods::Conf -> _text4secs ( $age ) ;

printf "$prog : your CPAN is in %s\n", $locl ;
printf "$prog : your CPAN is dated : %s\n", scalar localtime $time ; 
printf "$prog : your CPAN is %s old\n", $old ;
printf "$prog : your test CPAN is in %s\n", "$TST/CPAN/" ;

for my $dir ( $TST, "$TST/CPAN" )
  { -d $dir or mkdir $dir, 0755 or Error "can't mkdir $dir ($!)" ; }

unlink map { "$TST/CPAN/$_" ; } @RFS ;

if ( $age > 3 * 60 * 60 )
  { my $remo = $REMO ;
    my $rfs = join "\n      ", @RFS ;
    my $msg = <<MSG ;
$prog : looking at your CPAN archive $locl ...
  -> your CPAN is too old ; we will start with something more recent ;
  
    rsync from $remo into $TST/CPAN :

      $rfs

MSG
    print $msg ;
    my @cmd = 
      ( '|'
      , '/usr/bin/rsync'
      , '-av'
      , '--no-motd'
      , '--timeout'    => 60
      , '--contimeout' => 60
      , '--files-from' => '-'
      , $remo
      , "$TST/CPAN"
      ) ;
    my $cmd = join ' ', @cmd ;
    open CMD, $cmd or Error "fetching didn't work ; sorry" ;
    print CMD join "\n", @RFS ;
    close CMD ;
    my $all = 1 ;
    for my $rf ( @RFS )
      { unless ( -f "$TST/CPAN/$rf" )
          { printf "$prog : failed to get $rf\n" ; $all = 0 ; }
      }
    $all or Error "fetching didn't work ; sorry" ;
  }
else
  { my $cmd = "cp -a $locl/RECENT-*.json $TST/CPAN" ;
    printf "$prog : %s\n", $cmd ;
    system $cmd ; Error "can't do '$cmd' ($?)" if $? ;
  }

my $Conf = mk_conf $ABS ;
my $CONF = "$TST/iim.conf" ;
open CONF, ">$CONF" or Error "can't write $CONF ($!)" ;
print CONF $Conf ;
close CONF ;

my $sep = "######################" ;
printf "$prog : your test-config is :\n$sep\n%s$sep\n", $Conf ;

$sep = '---------------------------------------------------' ;
my $cmd = "perl -w iim -t -c $TST/iim.conf" ;
printf "$prog : running test ... : %s\n$sep\n", $cmd ;
system $cmd ; Error "can't do '$cmd' ($?)" if $? ;

print <<END ;
$sep
you can now run : perl iim -c $TST/iim.conf -v
or daemon mode  : perl iim -c $TST/iim.conf -v --daemon $TST
END