#!/usr/bin/env perl
#
# This file or a portion of this file is licensed under the terms of
# the Globus Toolkit Public License, found in file GTPL, or at
# http://www.globus.org/toolkit/download/license.html. This notice must
# appear in redistributions of this file, with or without modification.
#
# Redistributions of this Software, with or without modification, must
# reproduce the GTPL in: (1) the Software, or (2) the Documentation or
# some other similar material which is provided with the Software (if
# any).
#
# Copyright 1999-2004 University of Chicago and The University of
# Southern California. All rights reserved.
#
# Authors Jens Voeckler voeckler@cs.uchicago.edu
#         Gaurang Mehta gmehta@isi.edu
# Revision : $Revision: 2392 $
#
require 5.005;
use strict;

use File::Spec;
use Getopt::Long qw(:config no_ignore_case_always permute);
use DB_File;
use vars qw(%cache);		# real true global variable

sub usage
{
    print "Usage: replanner ...\n";

    print << 'EOF';		# avoid var interpolation
Options:
  --dir|-D dir     The directory in which you want to generate the submit files
  --dax|-d fn      The partition dax to work on.
  --pools|-p list  The pools on which you want to run the dax.
  --output|-o ph   The output pool on which you want the data.
  --force|-f       Use build mode instead of make mode.
  --randomdir|-r [randomdir]   Add random dir.
  --submit|-s      Directly submit to condor
  --version|-V     Print version number and exit.
  --verbose|-v     Be verbose about what you do.
  --autenticate|-a Check pools for validity.
  --help|-h        This help.
  --partition|-p   The name of the partion to work on
  --cache|-c       The cache file written by pegasus.
  --megadag|m      The megadag style
  --log|-l filename      ...
EOF
    exit(1);
}

my %conf = ( dir => undef,		dax => undef,
	     pools => [],		output => undef,
	     force => undef,		random => undef,
	     submit => undef,		version => undef,
	     verbose => undef,		authenticate => undef,
	     job => undef,		log => undef,
	     partitioncache =>undef,    cachefile => '.retrycache',
	     megadag =>undef);


my @addon;
while ( substr($ARGV[0],0,2) eq '-D' ) {
    my $arg = shift(@ARGV);
    $arg = '-D' . shift(@ARGV) if ( $arg eq '-D' );
    push( @addon, $arg );
}

#for ( @ARGV ) { print "BEFORE>> $_\n" }

#print "ADDON : @addon\n";

my $result=GetOptions( "dir|D=s"         =>\$conf{dir},
                       "dax|d=s"         =>\$conf{dax},
                       "pools|p=s"       => $conf{pools},
                       "output|o=s"      =>\$conf{output},
                       "force|f"         =>\$conf{force},
                       "randomdir|r:s"   =>\$conf{random},
                       "submit|s"        =>\$conf{submit},
		       "version|V"       =>\$conf{version},
		       "verbose|v"       =>\$conf{verbose},
		       "authenticate|a"  =>\$conf{authenticate},
                       "help|h"          =>\&usage,
		       "partition|P=s"   =>\$conf{job},
		       "cache|c=s"       =>\$conf{partitioncache},
		       "megadag|m=s"     =>\$conf{megadag},
		       "log|l=s"         =>\$conf{log});


#for ( @ARGV ) { print "AFTER>> $_\n" }

die "ERROR: You must specify a partion name with -P (mandatory option)\n" unless $conf{job};
die "ERROR: You must specify a log file name with -l (mandatory option)\n" unless $conf{log};



# you may have multiple -p options, each of which takes a comma-separated
# string. Canonize into one option here and now into while hash-converting.
my %pools = map { $_ => 0 } split( /,/, join(',', @{$conf{pools}} ) );
 
my $pegasushome = $ENV{'PEGASUS_HOME'};
my %global = 
    ( 
      pegasus => File::Spec->catfile( $pegasushome, 'bin', 'gencdag' ),
      parser => File::Spec->catfile( $pegasushome, 'bin', 'condor-log-parser' ),
      output => $conf{job} . '.out',
      error => $conf{job} . '.err',
      log => $conf{log}
    );
# BEWARE: Both $conf{output} and $global{output} are valid now -- but mean different.

# sanity checks
die( "ERROR: Unable to execute ", $global{pegasus} ) unless -x $global{pegasus};
warn("ERROR: Unable to execute ", $global{parser} ) unless -x $global{parser};

tie %cache, 'DB_File', $conf{cachefile} ||
    die( "ERROR: Opening cache file ", $conf{cachefile}, ": $!\n" );
#
# START OF NO die PERMITTED BLOCK
#



my $parsecommand = $global{parser} . ' ' . $global{log} . 
    '|sort -r|awk \'{print $2 " "$1}\'|uniq -d -f1 2>' . $global{error};
print "$parsecommand\n";
if ( open( PARSE, "$parsecommand |" ) ) {
    while ( <PARSE> ) {
	s/[\r\n]+$//;		# chomp safely
	my ($k,$v) = split /\s/;
	delete $pools{$k};	# remove from good pools
	$cache{$k} = time();	# add with timestamp to bad pool cache
    }
    close PARSE;
} else {
    warn( "Warning: Unable to execute $parsecommand: $!, rc=", $? >> 8, "\n",
	  "Bad pool collection will be empty, continuing execution\n" );
}
my @pools = keys %pools;

# some debugging -- show summary of bad hosts
print( 'BAD:  ', join(',',keys %cache) || '(empty - THIS IS GOOD)', "\n" );
print( 'GOOD: ', join(',',@pools) || '(none - THIS IS FATAL)', "\n" );

untie %cache;
#
# END OF NO die PERMITTED BLOCK
#

# Better die now than try to run with wrong arguments
die "ERROR: There are not good pools left!\n" if ( @pools == 0 );

my @args = ( $global{pegasus} );
push (@args, @addon) if (@addon > 0);
push( @args, '-d', $conf{dax} )		 if ( defined $conf{dax} );
push( @args, '-o', $conf{output} )	 if ( defined $conf{output} );
push( @args, '-c', $conf{partitioncache} )  if ( defined $conf{partitioncache} );
push( @args, '-m', $conf{megadag} )      if ( defined  $conf{megadag});
push( @args, '-D', $conf{dir} )	 if ( defined $conf{dir} );
push( @args, '-f' )	if ( $conf{force} );

if (defined $conf{random} && $conf{random}) {
    push( @args, "-r=$conf{random}" );
}
elsif (defined $conf{random}) {
     push( @args, "-r" );}

push( @args, '-s' )	if ( $conf{submit} );
push( @args, '-V' )	if ( $conf{version} );
push( @args, '-v' )	if ( $conf{verbose} );
push( @args, '-a' )	if ( $conf{authenticate} );
push( @args, '-p', join(',', @pools ) );

# say it
#print "\n", join(' ', @args ), "\n";

print "COMMAND = @args\n";

my $pid = fork();
if ( $pid == 0 ) {
    # child
    open STDERR, '>>' . $global{error};
    select STDERR;
    $|=1;
    open STDOUT, '>>' . $global{output};
    select STDOUT;
    $|=1;

    exec { $args[0] } @args;
    exit 127;			# never reached
}
waitpid( $pid, 0 );
my $returncode = $?>>8;
print "$returncode\n";
exit $returncode;
