#!/usr/bin/perl
#
# scan job execution log files from the HPC2N cluster (Maui format), and use
# convert2swf_v2.pm to convert the data into the standard workload format.
#


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


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

my $tz_str    = "Europe/Stockholm";
my $max_procs = 240;

my @queues = ();

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 the HPC2N workload

# the format of the log corresponds to the Maui log format.
# see http://www.clusterresources.com/products/maui/docs/16.3workloadtrace.shtml.

my $job_cnt;
my $running;
my $running_not;
my $problem1;
my $problem2;
my $problem3;
my $problem4;
my $problem5;
my $problem6;
my $problem7;
my $problem8;
my $problem9;
my $problem10;
my $problem11;


# note jobs with (undefined, spurious) "running" status
my %running_jobs;
# count procs/task
my %proc_task;
my %tasks_node;

sub get_jobs {
##############
# parse input format and create a hash for each job

  my @list_of_jobs;
  $job_cnt   = 0;
  $running   = 0;
  $running_not = 0;
  $problem1  = 0;
  $problem2  = 0;
  $problem3  = 0;
  $problem4  = 0;
  $problem5  = 0;
  $problem6  = 0;
  $problem7  = 0;
  $problem8  = 0;
  $problem9  = 0;
  $problem10 = 0;
  $problem11 = 0;
  $tasks_node{0}=0;
  $tasks_node{1}=0;
  $tasks_node{2}=0;
  $proc_task{0} =0;
  $proc_task{1} =0;
  $proc_task{2} =0;
  #
  # scan trace and collect job info
  #
  while (<>) {
    last if ($job_cnt==527371);
    if (/^\s*$/) {		# empty line
      next;
    }
    
    $_ =~ /\s*(.*)\s*/;		# get rid of white space at ends
    $_ = $1;
    my @line = split('\s+');	# split into fields


    my %nj;

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

    $nj{trace}  = $_;	# used for error messages

    $nj{submit} = $line[8];  # OK

    $nj{start}  = $line[10]; # OK

    $nj{end}    = $line[11]; # OK

    #wait = start - submit;
    #run = end - start;

    # two processors per allocated node; nodes are given as a list.
    my $alloc_nodes_list = $line[37];
    my @hosts = split(/:/, $alloc_nodes_list);
    my $alloc_nodes = @hosts;
    my $alloc_procs = 2 * $alloc_nodes;

    # processors actually used are tasks x procs per task
    # (this is the resources used; parallelism may be better represented by just the tasks)
    my $tasks = $line[21];
    my $used_procs = $tasks * $line[31];

    if ($used_procs != 0) {
      $nj{procs} = $used_procs;
    }
    else {
      $nj{procs} = $alloc_procs;
    }

    my $total_cpu = $line[29];
    if ($tasks != 0) {
      $nj{cpu} = $total_cpu / $tasks;
    }

    #This is Required (Used) RAM Memory per task
    #(sometimes the number has 'M' attached to it, which means MB)
    my $memory;
    if ($line[32] =~ /(\d+)M/) {
      $memory = $1;
    }
    else {
      $memory = $line[32]
    }

    my $proc_per_task = $line[31];

    if ($proc_per_task != 0) {
      $nj{mem} = (1024*$memory) / $proc_per_task;
    }

    my $req_tasks = $line[2];

    $nj{req_procs} = $req_tasks * $proc_per_task;


    $nj{req_time} = $line[5];

    #This is Required Node Memory (per node, but assumed per processor).
    #Again, sometimes we have to remove the 'M' at the end.
    my $req_memory;
    if ($line[16] =~ /(\d+)M/) {
      $req_memory = $1;
    }
    else {
      $req_memory = $line[16]
    }
    $nj{req_mem} = 1024 * $req_memory;

    my $status_id;
    if ($line[6] eq "Completed") {
      $status_id=1;
      if ($running_jobs{$line[0]}) {$running_not++; warn "Job was previously 'Running' but is now 'Completed'.\n";}
    }
    elsif ($line[6] eq "Removed") {
      $status_id=5;
      if ($running_jobs{$line[0]}) {$running_not++; warn "Job was previously 'Running' but now 'Removed'.\n";}
    }
    elsif ($line[6] eq "NotRun") {
      $status_id=0;
      if ($running_jobs{$line[0]}) {$running_not++; warn "Job was previously 'Running' but now 'NotRun'.\n";}
    }
    else {
      $status_id=-1;
      # this is not defined in the documentation, but appears in the log
      if ($line[6] eq "Running") {
	$running_jobs{$line[0]} = 1;
	$running++;
	#print ">>> RUNNING job started ",strftime("%R %d %b %Y",localtime($line[10])),
	#      " and ended ",strftime("%R %d %b %Y",localtime($line[11])),"\n";
      }
    }
    $nj{status} = $status_id;


    my $user = -1;
    if ($line[3] =~ /user0*(\d+)/) {
      $user = $1;
    }
    $nj{user}  = $user;

    my $group = -1;
    if ($line[4] =~ /group0*(\d+)/) {
      $group = $1;
    }
    $nj{group} = $group;

    if ($line[26] ne "[NONE]") {
      $nj{app} = $line[26];
    }

    $nj{queue} = $line[7];  #OK

    $nj{partition} = $line[30]; #OK


    #SOME SANITY CHECKS

    #Is number of processors per task always 1?
    if (($line[31]!=1)) {
      $problem1++;
    }
    $proc_task{$line[31]}++;

    #Is alloc.procs based on tasks the same as based on nodes?
    if (($alloc_procs != $used_procs) && ($alloc_procs != $used_procs+1)) {
      $problem2++;
    }

    #Is alloc.procs sufficient at all times?
    if ($alloc_procs < $used_procs) { #alloc.procs is less than tasks*procs per task.
      $problem3++;
    }

    #If req_nodes isn't 0 then is it the length of the host list?
    if (($line[1]!=0)&&($line[1]!= @hosts)){
      $problem4++;
    }

    #Is amount of RAM memory required per processor always 0? Many times, so this data is relevant.
    if ($line[31]!=0) {
      if (($memory/$line[31])!=0) {
        $problem5++;
      }
    }

    #Is used RAM memory per processor always less than the requested memory per processor?
    if ($line[31]!=0) {
      if ((((1024*$memory)/$line[31]) > (1024*$req_memory))&&($req_memory!=0)) {
        $problem6++;
      }
    }

    #Is number of requested tasks equal to number of allocated tasks?
    if ($line[2] != $line[21]) {
      $problem7++;
    }

    #is Tasks per node always 0/1/2?
    if (($line[22]!=2)&&($line[22]!=1)&&($line[22]!=0)) {
      $problem8++;
    }
    $tasks_node{$line[22]}++;

    #Is dispatch time always less than start time?
    if ($line[9] > $line[10]) {
      $problem9++;
    }

    #Is nodes as computed based on tasks right?
    if (($line[22] != 0) && ($alloc_nodes != $line[21]/$line[22])) { # tasks / tasks per node
      $problem10++;
    }

    #Does run time adhere to wallclock limit?
    if ($alloc_procs!=0) {
      if (($line[11]-$line[10]) > $line[5]) {
        $problem11++;
      }
    }

    $list_of_jobs[$job_cnt++] = \%nj;

  }

  $format_bugs .= "Jobs where alloc.tasks does not equal to requested tasks: $problem7\n";
  $format_bugs .= "Jobs where procs per task isn't 1: $problem1\n";
  $format_bugs .= " Jobs with 0 procs per task: $proc_task{0}\n";
  $format_bugs .= " Jobs with 1 procs per task: $proc_task{1}\n";
  $format_bugs .= " Jobs with 2 procs per task: $proc_task{2}\n";

  $format_bugs .= "\nJobs where req. nodes is not zero, but does not equal to host list length: $problem4\n";
  $format_bugs .= "Jobs where tasks per node is not 0/1/2: $problem8\n";
  $format_bugs .= " Jobs with 2 tasks per node (normal): $tasks_node{2}\n";
  $format_bugs .= " Jobs with 1 task per node: $tasks_node{1}\n";
  $format_bugs .= " Jobs with 0 tasks per node: $tasks_node{0}\n";

  $format_bugs .= "\nJobs where alloc. procs (2*nodes) isn't (tasks*procs per task [+1]): $problem2\n";
  $format_bugs .= "Jobs where alloc. procs are less than req.tasks*procs per task: $problem3\n";
  $format_bugs .= "Jobs where alloc. nodes is not tasks / tasks per node: $problem10\n";

  $format_bugs .= "\nJobs where dispatch time was after start time: $problem9\n";
  $format_bugs .= "Jobs who don't adhere to their wallclock limit: $problem11\n";

  $format_bugs .= "\nJobs where required RAM is not 0: $problem5\n";
  $format_bugs .= "Jobs where used RAM per proc. was greater than requested RAM per proc: $problem6\n";

  $format_bugs .= "\nJobs which were found with running status: $running\n";
  $format_bugs .= " Jobs with running status later getting other status: $running_not\n";

  return \@list_of_jobs;
}


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: Linux cluster (Seth)\n";
  $header .= "; Installation: HPC2N - High Performance Computing Center North, Sweden\n";

  $header .= "; Acknowledge: Ake Sandgren\n";
  $header .= "; Information: http://www.hpc2n.umu.se/support/userguide/Seth/batchsystem.html\n";

  $header .= sprintf("; Conversion: Sarah Gingichashvili and 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 .= "; TimeZone: 3600\n";
  $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 .= "; MaxNodes: $max_procs\n";
  $header .= "; MaxProcs: $max_procs\n";

  $header .= "; Note: uses MAUI scheduler\n";

  return $header;
}
