################################################################################
#      writer: Dan Tsafrir (dants AT cs DOT huji DOT ac DOT il)
# description: Print the header and body of an already parsed PBS file in SWF.
################################################################################
package PrintSWF;
use warnings;
use strict;
use Time::Local;
use POSIX;
use Data::Dumper;

use lib '.';
use ConversionConfig;


################################################################################
# THE EXPORTED INTERFACE:
# 1) &print_swf_header
# 2) &print_swf_body
################################################################################
use Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw(&get_swf_header &print_swf_body);
our $VERSION = 1.00;
    
    
################################################################################
# internal vars
################################################################################
my $g_version = 2.2;	# first in header
my $g_pbs2swf = "http://www.cs.huji.ac.il/labs/parallel/workload/pbs2swf/";
my @g_width;		# $g_width[$i] = width of the $i-th field


################################################################################
# implementation
################################################################################


#-------------------------------------------------------------------------------
# compute values of all time related header fields.
#-------------------------------------------------------------------------------
sub get_times($$$) {

    my ($epoch_start, $swf, $tz_str) = @_;
    my %res;

    # first obtain the (deprecated) offset:
    # we do this by subtracting a local time epoch from its corresponding
    # GMT. recall that $ENV{TZ} is already set to the PBS local time.
    #
    # the date we use is 00:00:00 Feb 1 2005 which is usually winter...
    my ($sec,$min,$hour,$mday,$mon,$year) = (0, 0, 0, 1, 1, 2005);
    my $ltime = timelocal($sec,$min,$hour,$mday,$mon,$year);
    my $gtime = timegm   ($sec,$min,$hour,$mday,$mon,$year);
    $res{tz_offset}  = sprintf("%.0f", ($gtime-$ltime)/3600) * 3600;
    $res{tz_offset} .= "\t # DEPRECATED; use TimeZoneString + tzset()";

    # we already know the start_epoch, we also need the end_epoch, which
    # is defined to be the maximal arrival+waittime+runtime.
    my $i_sb      = $SWF_COL2INDEX0{submit };
    my $i_wt      = $SWF_COL2INDEX0{wait   };
    my $i_rt      = $SWF_COL2INDEX0{runtime};
    my $epoch_end = 0;
    foreach my $job (@$swf) {
	my ($sb, $wt, $rt) = ($job->[$i_sb] , $job->[$i_wt] , $job->[$i_rt]);
	my $end = $sb + ($wt >= 0 ? $wt : 0) + ($rt >= 0 ? $rt : 0);
	$epoch_end = $end
	    if( $epoch_end < $end );
    }
    $epoch_end += $epoch_start; # recall $swf is normalized => 1st arrival=0

    # now we want StartTime/EndTime which should look like so:
    #    Wed Jan 1 16:14:57 CET 2003
    $res{tstart} = strftime("%a %b %d %H:%M:%S %Z %Y", localtime($epoch_start));
    $res{tend  } = strftime("%a %b %d %H:%M:%S %Z %Y", localtime($epoch_end  ));

    $res{tz_str} = $tz_str;

    return \%res;
}


#-------------------------------------------------------------------------------
# generate and return the header of the SWF file.
#  Preemption  MaxQueues  MaxPartitions
#-------------------------------------------------------------------------------
sub get_swf_header($$$) {
    
    my ($swf, $anonymize, $epoch_start) = @_;
    my $header = $CONFIG{header};  # user specified header fields
    my $idx    = 0;		   # index to @$header
    my $n      = scalar(@$header); # size of @$header
    my $res    = "";		   # to be returned
    my $w      = 15;		   # max width of header field
    my $fmt    = "; %${w}s: %s\n"; # format of canonical header lines


    # 1:
    # all the mandatory header fields that the user must specified are at 
    # the beginning of @$header. these are (in order):
    #
    #   Computer, Installation, Information, Acknowledge, Conversion, 
    #   TimeZoneString, MaxNodes, MaxProcs.
    # 
    # so let's start by printing everything until 'Conversion' (including):
    $res .= sprintf($fmt, 'Version' , "2.2" );
    for($idx=0; $header->[$idx]{name} ne 'TimeZoneString'; $idx++) {
	my $f = $header->[$idx];
	$res .= sprintf($fmt, $f->{name}, $f->{value});
	$res .= ";\n" if $f->{name} eq 'Acknowledge';
    }
    $res .= sprintf($fmt, 'Conversion', "Automatically generated by '$0'");
    $res .= sprintf($fmt, 'Conversion', "See: $g_pbs2swf");
    $res .= ";\n";


    # 2:
    # now we print all the time-related stuff which aside from TimeZoneString
    # we can compute by ourselves. something like:
    #
    # ; UnixStartTime: 1041434097
    # ;      TimeZone: 3600        # DEPRECATED. use TimeZoneString + tzset()
    # ;TimeZoneString: Europe/Amsterdam  # CET (Central European Time; UTC+1)
    # ;     StartTime: Wed Jan 1 16:14:57 CET 2003 
    # ;       EndTime: Thu Jan 1 16:07:28 CET 2004
    #
    $header->[$idx]{name} eq 'TimeZoneString' or die "bug";
    my $t = get_times($epoch_start, $swf, $header->[$idx++]{value} );
    $res .= sprintf($fmt, 'UnixStartTime' , $epoch_start     );
    $res .= sprintf($fmt, 'TimeZone'      , $t->{tz_offset}  );
    $res .= sprintf($fmt, 'TimeZoneString', $t->{tz_str}     );
    $res .= sprintf($fmt, 'StartTime'     , $t->{tstart}     );
    $res .= sprintf($fmt, 'EndTime'       , $t->{tend}       );
    $res .= ";\n";


    # 3: 
    # this is the section of all the 'max' header fields along with other
    # limitations. it includes 
    #   MaxJobs, MaxRecords, MaxNodes, MaxProcs, MaxRuntime, MaxMemory, 
    #   AllowOveruse, Preemption
    # it's end is marked with Queues (which always exists because it has a
    # default value)
    my $njobs = scalar(@$swf);
    $res .= sprintf($fmt,'MaxJobs'   , $njobs);
    $res .= sprintf($fmt,'MaxRecords', $njobs);

    for( ; ($idx < $n) && ($header->[$idx]{name} !~ m/Queues/) ; $idx++) {
	my $f = $header->[$idx];
	$res .= sprintf($fmt, $f->{name}, $f->{value});
    }
    $res .= sprintf($fmt, 'Preemption', 'No');
    $res .= ";\n";


    # 4: 
    # queues. both the user's 'Queues', and the 'Queue' per PBS-queue specifying
    # its PBS-name and corresponding SWF code.
    $header->[$idx]{name} eq 'Queues' or die "bug";
    for( ; ($idx < $n) && ($header->[$idx]{name} =~ m/Queues/) ; $idx++) {
	my $f  = $header->[$idx];
	$res  .= sprintf($fmt, $f->{name}, $f->{value});
    }
    my $qs      = $anonymize->{queue};
    my $nqueues = scalar(keys %$qs);
    if( $nqueues > 0 ) {
	$res .= sprintf($fmt, 'Queues', '-----------------');
	$res .= sprintf($fmt, 'Queues', 'SWF-ID   PBS-name');
	$res .= sprintf($fmt, 'Queues', '-----------------');
	foreach my $q (sort {$qs->{$a} <=> $qs->{$b}} keys %$qs) {
	    $res .= sprintf($fmt, 'Queue', sprintf("%6d   %s", $qs->{$q}, $q) );
	}
	$res .= sprintf($fmt, 'MaxQueues', $nqueues);
    }
    $res .= ";\n";


    # 5: 
    # partitions. both the user's 'Partitions', and the 'Partition' per
    # PBS-partition specifying its PBS-name and corresponding SWF code.
    $header->[$idx]{name} eq 'Partitions' or die "bug";
    for( ; ($idx < $n) && ($header->[$idx]{name} =~ m/Partitions/) ; $idx++) {
	my $f  = $header->[$idx];
	$res  .= sprintf($fmt, $f->{name}, $f->{value});
    }
    my $ps          = $anonymize->{partition};
    my $npartitions = scalar(keys %$ps);
    if( scalar(keys %$ps) > 0 ) {
	$res .= sprintf($fmt, 'Partitions', '-----------------');
	$res .= sprintf($fmt, 'Partitions', 'SWF-ID   PBS-name');
	$res .= sprintf($fmt, 'Partitions', '-----------------');
	foreach my $p (sort {$ps->{$a} <=> $ps->{$b}} keys %$ps) {
	    $res .= sprintf($fmt, 'Partition', 
			    sprintf("%6d   %s", $ps->{$p}, $p) );
	}
	$res .= sprintf($fmt, 'MaxPartitions', $npartitions);
    }
    $res .= ";\n";


    # 6: 
    # notes. first, that which correspond to the meaning of columns as is 
    # enforced by the script. then, user's notes.
    my $spec = $CONFIG{spec};
    foreach my $swf_field (keys %$spec) {
	my $s = sprintf("The %-10s column relates to:", "'$swf_field'");
	while( my ($name, $value) = each %{$spec->{$swf_field}} ) {
	    $s .= sprintf(" %-20s", "$name=$value");
	}
	$res .= sprintf($fmt, 'Note', $s);
    }
    $res .= sprintf($fmt, 'Note', 
	       "proc_used=0 means job was canceled before it started to run");
    for( ; $idx < $n ; $idx++) {
	my $f  = $header->[$idx];
	$res  .= sprintf($fmt, $f->{name}, $f->{value});
    }

    return $res;
}



#-------------------------------------------------------------------------------
# fill %g_width
#-------------------------------------------------------------------------------
sub fill_width($) {
    
    my $swf   = shift;
    @g_width = map {0} (1..$SWF_COLNUM);

    foreach my $job (@$swf) {
	foreach my $i (0..($SWF_COLNUM-1)) {
	    my $len      = length($job->[$i]);
	    $g_width[$i] = $len if( $g_width[$i] < $len );   
	}
    }
}


#-------------------------------------------------------------------------------
# print an swf scheme (field structure)
#-------------------------------------------------------------------------------
sub print_swf_scheme($)
{
    my $fd    = shift;
    my %width = map { $_ => $g_width[ $SWF_COL2INDEX0{$_} ] } @SWF_COLS;

    # compute how many lines
    my $nlines = 0;
    foreach my $field (@SWF_COLS) {
        my $len = length($field);
        $nlines = $len if $len > $nlines;
    }

    print $fd ";\n";
    print $fd ";\n";
    
    # print scheme
    for(my $i=0; $i<$nlines; $i++) {
        foreach my $field (@SWF_COLS) {

            my $w   = $width{$field} or die "${field}'s width not found";
            my $len = length($field);
            my $c   = $i < $len ? substr($field,$i,1) : "";
            $c      = " " if $c eq "_";

	    if( $field eq 'job' ) {
		$w--;
		printf($fd ";%${w}s", $c);
	    }
	    else {
		printf($fd "|%${w}s", $c);
	    }
	}
        print $fd "\n";
    }
}


#-------------------------------------------------------------------------------
# write the new swf
#-------------------------------------------------------------------------------
sub print_swf_body($$$) 
{
    my ($fd, $swf, $header) = @_;
    my $debug = $CONFIG{other}{debug};

    print $fd $header;
    fill_width($swf);
    print_swf_scheme($fd);

    # we need to apply the overwrite defaults. do be efficient, we want 
    # an array to be indexed by the serial of the field such that the
    # associated entry is 
    # 1) true iff the field must be overwritten.
    # 2) the overwriting value.
    # 3) a ref2arr to be indexed by whether the job was started (1) or not (0)
    #    such that the associated value is whether the field should be 
    #    overwritten or not.
    my @need_owrt = ();
    my @owrt_val  = ();
    my @owrt_who  = ();
    foreach my $field (@SWF_COLS) {

	my $inf  = $CONFIG{defaults}{$field};

	if( ! defined($inf->{overwrite}) || ($inf->{overwrite} != 1) ) {
	    push @need_owrt, 0;
	    push @owrt_val , undef;
	    push @owrt_who , undef;
	} 
	else {
	    my @h = (-1,-1);
	    $h[0] = ( ($inf->{jobs} eq 'all') || ($inf->{jobs} eq 'canceled') );
	    $h[1] = ( ($inf->{jobs} eq 'all') || ($inf->{jobs} eq 'started' ) );
	    push @need_owrt, 1;
	    push @owrt_val , $inf->{value};
	    push @owrt_who , \@h;
	}
    }

    # print the body
    my $i_proc_used = $SWF_COL2INDEX0{proc_used};
    my $i_status    = $SWF_COL2INDEX0{status};
    foreach my $job (@$swf) {

	foreach my $i (0..($SWF_COLNUM-1)) {

	    my $wid = $g_width[$i];
	    my $val = $job->[$i];
	    
	    if( $need_owrt[$i] ) {
		my $started = ( $job->[$i_proc_used] != 0 || 
				$job->[$i_status]    != 5 ) ? 1 : 0;
		$val = $owrt_val[$i]
		    if( $owrt_who[$i][$started] );
	    }

	    printf( $fd "%s%${wid}.0f", ($i ? " " : ""), $val);
	}

	print $fd " $job->[-1]"
	    if $debug;
	print $fd "\n";
    }
}


#-------------------------------------------------------------------------------
# end module
#-------------------------------------------------------------------------------
1;

################################################################################
#                                   EOF
################################################################################
