#!/usr/bin/perl
#
# scan job execution log files from the PIK system, and
# use convert2swf.pm to convert the data into the standard workload format.
#

use warnings;
use strict;
use Time::Local;
use POSIX;
use convert2swf_v5;


############################
#
# DO THE CONVERSION:
#

my $tz_str    = "Europe/Berlin";
my $max_procs = 2560;
my @queues    = ("short",
		 "medium",
		 "long",
		 "largemem",
		 "dev",
		 "io",
		 "viss",
		 "clme",
		);

log_init();
SWF::init( $tz_str, $max_procs, \@queues );

my $format_bugs;
my $jobs_data = get_jobs();

my ($zero, $maxtime) = SWF::convert( $jobs_data, $format_bugs );

my $header = generate_header( $zero, $maxtime, $max_procs );

SWF::print( $header );



##################################
# SPECIFICS for PIK workload

# the format of each entry includes multiple lines as generated by
# LoadLeveler's llsummary command with the -l parameter.

my $job_cnt;
my $ppn;


sub log_init {
##############

    # ppn is processors per node
    $ppn = 8;
    $job_cnt = -1;
}


sub get_jobs {
##############
# parse input format and create a hash for each job.
# each job may include multiple steps, which are in fact individual jobs
# that depend on each other.
# the record for each job/step includes multiple lines with <key>: <value> format.
# jobs are delimited by lines with multiple ===, and steps by lines with ---.
# each job starts with some shared fields, and then come the individual steps.

    my @list_of_jobs;
    my $user;
    my $group;
    my $prev_end;
    my $steps=0;

    #
    # scan trace and collect job info
    #
    while (<>) {

	# identify new job start
	if (/^==========/) {

	    if ($steps != 0) {
		# problem if any left over from previous job
		$format_bugs .= "many_steps_problem [$steps] $_\n";
	    }

	    ($user, $group, $steps) = get_one_job();
	    $prev_end = -1;
	}

	# identify new step start
	if (/^----------/) {

	    my $step;
	    $step = get_one_step($user, $group, $prev_end, $job_cnt);
	    # $job_cnt is still number of previous job, in case of dependency

	    $prev_end = defined($step->{end}) ? $step->{end} : -1;
	    $job_cnt++;
	    $step->{num} = $job_cnt;

	    # ignore "Idle" status -- these jobs were not handled yet
	    # when the log was cut, and will appear again later
	    if ($step->{status} != 2) {
		$list_of_jobs[$job_cnt] = $step;
	    }
	    else {
		undef %$step;
		$job_cnt--;
	    }

	    $steps--;
	}
    }

    return \@list_of_jobs;
}


sub get_one_job {
#################
# get job shared fields, which are user and group

    my $user;
    my $group;

    while (<>) {

	$_ =~ /\s*(.*)\s*/;		# get rid of white space at ends
	$_ = $1;

	my $field;
	my $val;
	if (/^(.+): (.+)$/) {
	    $field = $1;
	    $val   = $2;
	}
	else {
	    next;
	}

	if ($field eq "Submitting Userid") {
	    $user  = $val;
	}

	if ($field eq "Submitting Groupid") {
	    $group = $val;
	}

	if ($field eq "Number of Steps") {
	    return ($user, $group, $val);
	}
    }
}


sub get_one_step {
##################
# the record for each job includes multiple lines with <key>: <value> format.
# we handle them in order of apprearance.

    my ($user, $group, $prev_end, $prev_job) = @_;
    my %nj;

    $nj{user}  = $user;
    $nj{group} = $group;

    my %months = (
	Jan => 0,
	Feb => 1,
	Mar => 2,
	Apr => 3,
	May => 4,
	Jun => 5,
	Jul => 6,
	Aug => 7,
	Sep => 8,
	Oct => 9,
	Nov => 10,
	Dec => 11
	);

    while (<>) {

	$_ =~ /\s*(.*)\s*/;		# get rid of white space at ends
	$_ = $1;

	my $field;
	my $val;
	if (/^(.+): (.+)$/) {
	    $field = $1;
	    $val   = $2;
	}
	else {
	    next;
	}

	#
	# set the desired fields as specified in convert2swf.pm
	#

	if ($field eq "Job Id") {
	    $nj{trace}  = $val;	# used for error messages
	}

	if ($field eq "Queue Date") {
	    # date/time has annoying human-readable format
	    my $submit;
	    if ($val =~ /(\d\d) (\w\w\w) (\d\d\d\d) (\d\d):(\d\d):(\d\d) (\w\w) (\w{3,4})/) {
		my $yr  = $3;
		my $mon = $months{$2};
		my $day = $1;
		my $hr  = $4;
		$hr = 0 if ($hr == 12);
		$hr += 12 if ($7 eq "PM");
		# 12AM => 00 (midnight), 12PM => 12 (noon)
		my $min = $5;
		my $sec = $6;
		my $tz = $8;

		$ENV{TZ} = $tz;
		POSIX::tzset();
		$submit = &timegm($sec, $min, $hr, $day, $mon, $yr);

		#print "submit $val => $day/$mon/$yr at $hr:$min:$sec\n";
	    }
	    else {
		$submit = -1;
	    }
	    $nj{submit} = $submit;
	}

	if ($field eq "Status") {
	    if ($val eq "Completed") {
		$nj{status} = 1;
	    }
	    elsif ($val eq "Idle") {
		$nj{status} = 2;	# partial execution -- actually the job
					# was submitted but not handled yet
		$format_bugs .= "idle_status $_\n";
	    }
	    elsif ($val eq "Removed") {
		$nj{status} = 5;
	    }
	    elsif ($val eq "Not Run") {
		$nj{status} = 5;
	    }
	    else {
		$format_bugs .= "unknown_status [$val] $_\n";
	    }
	}
	if ($field eq "Completion Code") {
	    if (($val != 0) && ($nj{status} == 1)) {
		$nj{status} = 0;
	    }
	}

	if ($field eq "Start Time") {
	    # date/time has annoying human-readable format
	    my $start;
	    if ($val =~ /(\d\d) (\w\w\w) (\d\d\d\d) (\d\d):(\d\d):(\d\d) (\w\w) (\w{3,4})/) {
		my $yr  = $3;
		my $mon = $months{$2};
		my $day = $1;
		my $hr  = $4;
		$hr = 0 if ($hr == 12);
		$hr += 12 if ($7 eq "PM");
		my $min = $5;
		my $sec = $6;
		my $tz = $8;

		$ENV{TZ} = $tz;
		POSIX::tzset();
		$start = &timegm($sec, $min, $hr, $day, $mon, $yr);
	    }
	    else {
		$start = -1;
	    }
	    $nj{start} = $start;

	    # add dependency if relevant
	    if ($prev_end != -1) {
		$nj{prev_job} = $prev_job;
		$nj{think}    = $start - $prev_end;
	    }
	}

	if ($field eq "Completion Date") {
	    # date/time has annoying human-readable format
	    my $end;
	    if ($val =~ /(\d\d) (\w\w\w) (\d\d\d\d) (\d\d):(\d\d):(\d\d) (\w\w) (\w{3,4})/) {
		my $yr  = $3;
		my $mon = $months{$2};
		my $day = $1;
		my $hr  = $4;
		$hr = 0 if ($hr == 12);
		$hr += 12 if ($7 eq "PM");
		my $min = $5;
		my $sec = $6;
		my $tz = $8;

		$ENV{TZ} = $tz;
		POSIX::tzset();
		$end = &timegm($sec, $min, $hr, $day, $mon, $yr);
	    }
	    else {
		$end = -1;
	    }
	    $nj{end} = $end;
	}

	# command used (may be script)
	if ($field eq "Cmd") {

	    $nj{app} = $val;
	}

	# number of processors:
	if (($field eq "Step Type") && ($val eq "Serial")) {
	    $nj{procs} = 1;
	}

	if ($field eq "Min Processors") {
	    if (defined($nj{procs})) {
		$format_bugs .= "procs_twice [prev=$nj{procs}] $_\n";
	    }
	    my $procs = $val;
	    $nj{procs} = $procs;
	}
	if ($field eq "Max Processors") {
	    if (! defined($nj{procs})) {
		my $procs = $val;
		$nj{procs} = $procs;
		$format_bugs .= "min_procs_missing $_\n";
	    }
	    elsif ($nj{procs} != $val) {
		$format_bugs .= "min_max_procs_mismatch [min=$nj{procs}] $_\n";
	    }
	    # else is OK
	}
	# we lose info on allocated nodes and whether they were shared or not

	# use class as proxy for queue
	if ($field eq "Class") {

	    # some specific cleanup
	    if ($val =~ /^\"(.*)\"$/) {
		$val = $1;
	    }
	    $val = -1 if ($val eq "(null)");

	    $nj{queue} = $val;
	}

	# requested run time
	if ($field eq "Wall Clk Hard Limit") {

	    # get number of seconds
	    if ($val =~ /(\d+) seconds/) {
		$val = $1;
		$nj{memtot} = $val;
	    }
	}

	# total memory
	if ($field eq "Step Real Memory") {

	    # get number and convert to KB
	    if ($val =~ /^([\d\.]+) gb$/) {
		$val = $1 * 1024 * 1024;
		$nj{memtot} = $val;
	    }
	}

	# CPU time (given as per-proc)
	if ($field eq "Step Total Time") {

	    # handle the format
	    my $secs;
	    if ($val =~ /^((\d+)\+)?(\d\d):(\d\d):(.*)$/) {
		my $days = 0;
		$days = $2 if (defined($1));
		my $hr   = $3;
		my $min  = $4;
		$secs = $5;

		$secs += (($days*24 + $hr)*60 + $min)*60;
	    }

	    $nj{cpu} = $secs;

	    return \%nj;
	}
    }
}


sub generate_header {
#####################
    my ($zero, $maxtime, $max_procs) = @_;

    my ($sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst);


    $header  = "; Version: 2.2\n";
    $header .= "; Computer: IBM iDataPlex Cluster\n";
    $header .= "; Installation: PIK (Potsdam Institute for Climate Impact Research)\n";

    $header .= "; Acknowledge: Ciaron Linstead\n";
    $header .= "; Information: http://www.pik-potsdam.de/services/it/hpc/\n";
    $header .= "; Information: http://www.cs.huji.ac.il/labs/parallel/workload/\n";

    $header .= sprintf("; Conversion: Dror Feitelson (feit\@cs.huji.ac.il) %s\n",
		       strftime("%d %b %Y", localtime()));


    $header .= sprintf("; MaxJobs: %d\n", $job_cnt);
    $header .= sprintf("; MaxRecords: %d\n", $job_cnt);
    $header .= "; Preemption: No\n";

    $header .= sprintf("; UnixStartTime: %d\n", $zero);
    $header .= sprintf("; TimeZoneString: %s\n", $tz_str);

    $header .= sprintf("; StartTime: %s\n",
	   strftime("%a %b %2d %H:%M:%S %Z %Y", localtime($zero)));

    $header .= sprintf("; EndTime:   %s\n",
	   strftime("%a %b %2d %H:%M:%S %Z %Y", localtime($maxtime)));

    $header .= sprintf("; MaxNodes: %d\n", $max_procs / $ppn);
    $header .= "; MaxProcs: $max_procs\n";

    $header .= "; Information: Each node has two 4-core CPUs, for a total of 8 cores\n";
    $header .= "; Information: 32 GB memory per node (shared by the 8 cores)\n";
    $header .= "; Information: total of 800 TB disk space\n";

    return $header;
}

