#! /usr/bin/env perl
##**************************************************************
##
## Copyright (C) 1990-2011, Condor Team, Computer Sciences Department,
## University of Wisconsin-Madison, WI.
## 
## Licensed under the Apache License, Version 2.0 (the "License"); you
## may not use this file except in compliance with the License.  You may
## obtain a copy of the License at
## 
##    http://www.apache.org/licenses/LICENSE-2.0
## 
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
##**************************************************************

use CondorTest;
use CondorUtils;

my $testname = "job_hgq_autoregroup_basic_van";

#testreq: personal
my $config = <<CONDOR_TESTREQ_CONFIG;
# This was a hack to allow the test pool and harness pool to
# coexist peacefully on my sandbox.  I dont think they are needed
# in a "real" testing environment:
#COLLECTOR_ARGS = -p 42424
#COLLECTOR_HOST = $(CONDOR_HOST):0
#COLLECTOR_ADDRESS_FILE = $(LOG)/.collector_address
DAEMON_LIST = MASTER, COLLECTOR, NEGOTIATOR, STARTD, SCHEDD

NEGOTIATOR_DEBUG = D_FULLDEBUG

SCHEDD_INTERVAL	= 30
NEGOTIATOR_INTERVAL = 20

CLAIM_WORKLIFE = 0

# turn off preemption
MAXJOBRETIREMENTTIME = 3600 * 24
PREEMPT = False
PREEMPTION_REQUIREMENTS = False
RANK = 0
NEGOTIATOR_CONSIDER_PREEMPTION = False

# no slot weights
NEGOTIATOR_USE_SLOT_WEIGHTS = FALSE

NUM_CPUS = 4

# turn off round robin and multiple allocation rounds
HFS_ROUND_ROBIN_RATE = 100000000
HFS_MAX_ALLOCATION_ROUNDS = 1

GROUP_NAMES = a, b

# 2 slots are left over for root group "none"
GROUP_QUOTA_a = 1
GROUP_QUOTA_b = 1

# autoregroup is on, accept-surplus is off:
GROUP_ACCEPT_SURPLUS = FALSE
GROUP_AUTOREGROUP = TRUE

# sorts "b" before "a":
GROUP_SORT_EXPR = ifThenElse(AccountingGroup=?="a", 2, ifThenElse(AccountingGroup=?="b", 1, 3.40282e+38))

CONDOR_TESTREQ_CONFIG
#endtestreq

# trip whitespace from beginning and end of a string
sub trimws($) {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

my $on_evictedwithoutcheckpoint = sub {
};

my $aborted = sub {
};

my $execute_test_passed = 0;
my $negotiate_test_passed = 0;
my $pre_execution = 1;


sub timed_callback {
    if ($pre_execution) {
        # jobs aren't running yet, we can skip this callback.
		CondorTest::debug("timed_callback\n",1);
		CondorTest::RegisterTimed($testname, \&timed_callback, 15);
        return;
    }
	CondorTest::debug("timed_callback\n",1);
	my @addarray = ();
	my @sorted = ();
	my @unsorted = ();
	my %testhash = ();

    # skip this tests if we have already passed it
    if (!$execute_test_passed) {
        #my $stat = `condor_q -af AccountingGroup -constraint "JobStatus == 2" | sort | uniq -c`;
        my $stat = runCondorTool("condor_q -af AccountingGroup -constraint \"JobStatus == 2\"",\@adarray,2,{emit_output=>0});;
		foreach my $ad (@adarray) {
			fullchomp($ad);
			#print "push:$ad\n";
			push @unsorted, $ad;
		}
		@sorted = sort { $a cmp $b } @unsorted; # first we sort, then we count
		my $sortedsize = @sorted;
		#print "sorted size:$sortedsize\n";
		foreach my $group (@sorted) {
			#print "Group:$group\n";
			if(exists $testhash{$group}) {
				$testhash{$group} += 1;
			} else {
				$testhash{$group} = 1;
			}
		}
        my $tst = "";
		foreach my $key (sort keys %testhash) {
			$tst = $tst . " $testhash{$key} $key";
		}
		CondorTest::debug("tst: $tst\n",1);

        if ($tst == " 2 a.user 2 b.user") {
            # we detected the expected pattern of running jobs
            $execute_test_passed = 1;
			CondorTest::debug("Execute test passed\n",1);
        } else {
            CondorTest::debug("Did not see expected output.  What I saw was:\n",1);
            CondorTest::debug("$stat\n",1);
            # if this check failed, wait a little:
            sleep(5);
        }
    }

    if (!$negotiate_test_passed) {
        CondorTest::debug("Negotiate Test\n",1);
        my $neglog = trimws(`condor_config_val NEGOTIATOR_LOG`);
	my @slines = grep(/(Group.* - BEGIN|Negotiating with .* at)/, CondorTest::slurp($neglog));

		foreach my $line (@slines) {
        	CondorTest::debug("nt: $line",1);
		}
        # This always checks the first negotiation cycle (where somebody negotiated)
        my $succ = 1;
        my $expect = "";
        $expect = shift @slines || "";
        $expect =~ /Group b - BEGIN NEGOTIATION/  ||  ($succ = 0);
        $expect = shift @slines || "";
        $expect =~ /Negotiating with b.user/  ||  ($succ = 0);

        $expect = shift @slines || "";
        $expect =~ /Group a - BEGIN NEGOTIATION/  ||  ($succ = 0);
        $expect = shift @slines || "";
        $expect =~ /Negotiating with a.user/  ||  ($succ = 0);

        # I expect a and b to negotiate under <none> as well, as that is the
        # semantic of autoregroup:
        $expect = shift @slines || "";
        $expect =~ /Group <none> - BEGIN NEGOTIATION/  ||  ($succ = 0);
        my $saw_a_neg = 0;
        my $saw_b_neg = 0;
        $expect = shift @slines || "";
        $expect =~ /Negotiating with a.user/  &&  ($saw_a_neg=1);
        $expect =~ /Negotiating with b.user/  &&  ($saw_b_neg=1);
        $expect = shift @slines || "";
        $expect =~ /Negotiating with a.user/  &&  ($saw_a_neg=1);
        $expect =~ /Negotiating with b.user/  &&  ($saw_b_neg=1);
        unless ($saw_a_neg && $saw_b_neg) { $succ = 0; }

        if (!$succ) {
        	CondorTest::debug("Did not see expected output.  What I saw was:\n",1);
        	CondorTest::debug("$stat\n",1);
			CondorTest::RegisterTimed($testname, \&timed_callback, 15);
        } else {
        	CondorTest::debug("Saw what we wanted!\n",1);
			runToolNTimes("condor_rm -all",1 ,0);
			CondorTest::RegisterResult($succ, test_name, $testname);
			CondorTest::EndTest();
		}
        $negotiate_test_passed = $succ;
    }
	CondorTest::RegisterTimed($testname, \&timed_callback, 15);
}


sub execute_callback {
    if ($pre_execution) {
        # only do this once, to let all jobs have a chance to spin up
        sleep(10);
    }
    # flag that jobs have started
    $pre_execution = 0;
}


sub exit_callback {
    unless ($execute_test_passed && $negotiate_test_passed) {
        die "Failed to find expected negotiation order or pattern of running jobs";
    }
}



my $job_log = "$testname.log";

# submit jobs
my $submit_body = "
universe = vanilla
executable = x_sleep.pl
log = $job_log
output = $testname.out
error = $testname.err
notification = never
arguments = 3600
+AccountingGroup=\"a.user\"
queue 2
+AccountingGroup=\"b.user\"
queue 2
";

my $submit_filename = CondorTest::TempFileName("$testname.submit");
open(SUBMIT, ">$submit_filename") || die "Failed to open $submit_filename\n";
print SUBMIT $submit_body;
close(SUBMIT);

CondorTest::RegisterTimed($testname, \&timed_callback, 15);
CondorTest::RegisterExecute($testname, \&execute_callback);
CondorTest::RegisterExitedSuccess($testname, \&exit_callback);
CondorTest::RegisterEvictedWithoutCheckpoint($testname, $on_evictedwithoutcheckpoint);
CondorTest::RegisterAbort($testname, $aborted);

# Ensure earlier output doesn't confuse us.
unlink $job_log;

if (CondorTest::RunTest($testname, $submit_filename, 0)) {
    CondorTest::debug("$testname: SUCCESS\n",1);
    exit(0);
} else {
    die "$testname: CondorTest::RunTest() failed\n";
}
