pegasus-wms 4.0.1+dfsg-8 / usr / share / pegasus / visualize / show-run

#!/usr/bin/env perl
#
# preparse Condor combined log and gridstart output for ploticus drawing.
#
# $Id: show-run 3190 2010-12-17 23:26:04Z voeckler $
require 5.6.0;
use strict;
use Socket;
use POSIX qw();
use Time::Local;
use File::Temp;
use File::Basename;
use File::Spec;
use Getopt::Long qw(:config bundling);
use IO::File;
use Data::Dumper;
use XML::Parser;
use XML::Parser::Expat;

use lib File::Basename::dirname($0);
use Common;

sub ungarble($) {
    # purpose: permit oct, dec and hex input
    # paramtr: input string
    # returns: numeric value
    # remarks: oct() also does hex, bin, ... but not dec
    my $x = shift;
    substr($x,0,1) eq '0' ? oct($x) : $x+0;
}

%main::status = 
( 
  '000' => [ 'Job submitted', 'ULOG_SUBMIT' ],
  '001' => [ 'Job executing', 'ULOG_EXECUTE' ],
  '002' => [ 'Error in executable', 'ULOG_EXECUTABLE_ERROR' ],
  '003' => [ 'Job was checkpointed', 'ULOG_CHECKPOINTED' ],
  '004' => [ 'Job evicted from machine', 'ULOG_JOB_EVICTED' ],
  '005' => [ 'Job terminated', 'ULOG_JOB_TERMINATED' ],
  '006' => [ 'Image size of job updated', 'ULOG_IMAGE_SIZE' ],
  '007' => [ 'Shadow threw an exception', 'ULOG_SHADOW_EXCEPTION' ],
  '008' => [ 'Generic log event', 'ULOG_GENERIC' ],
  '009' => [ 'Job aborted', 'ULOG_JOB_ABORTED' ],
  '010' => [ 'Job was suspended', 'ULOG_JOB_SUSPENDED' ],
  '011' => [ 'Job was unsuspended', 'ULOG_JOB_UNSUSPENDED' ],
  '012' => [ 'Job was held', 'ULOG_JOB_HELD' ],
  '013' => [ 'Job was released', 'ULOG_JOB_RELEASED' ],
  '014' => [ 'Parallel node executed', 'ULOG_NODE_EXECUTE' ],
  '015' => [ 'Parallel node terminated', 'ULOG_NODE_TERMINATED' ],
  '016' => [ 'POST script terminated', 'ULOG_POST_SCRIPT_TERMINATED' ],
  '017' => [ 'Job submitted to Globus', 'ULOG_GLOBUS_SUBMIT' ],
  '018' => [ 'Globus submit failed', 'ULOG_GLOBUS_SUBMIT_FAILED' ],
  '019' => [ 'Globus resource up', 'ULOG_GLOBUS_RESOURCE_UP' ],
  '020' => [ 'Globus resource down', 'ULOG_GLOBUS_RESOURCE_DOWN' ],

  '021' => [ 'Remote error', 'ULOG_REMOTE_ERROR' ],
  '022' => [ 'RSC socket lost', 'ULOG_JOB_DISCONNECTED' ],
  '023' => [ 'RSC socket re-established', 'ULOG_JOB_RECONNECTED' ],
  '024' => [ 'RSC reconnect failure', 'ULOG_JOB_RECONNECT_FAILED' ],
  '025' => [ 'Grid machine is up', 'ULOG_GRID_RESOURCE_UP' ],
  '026' => [ 'Grid machine is down', 'ULOG_GRID_RESOURCE_DOWN' ],
  '027' => [ 'Job submitted to Grid', 'ULOG_GRID_SUBMIT' ],
  '028' => [ 'Job Ad information update', 'ULOG_JOB_AD_INFORMATION' ],
  '029' => [ 'Job state is unknown', 'ULOG_JOB_STATUS_UNKNOWN' ],
  '030' => [ 'Job state is known', 'ULOG_JOB_STATUS_KNOWN' ],
  '031' => [ 'Condor-I/O stage-in', 'ULOG_JOB_STAGE_IN' ],
  '032' => [ 'Condor-I/O stage-out', 'ULOG_JOB_STAGE_OUT' ]
);

@main::statmsg = 
( 'failed', 'worker', 'stage-in', 'stage-out', 'replica',
  'double fault', 'failed worker', 'failed stage-in', 'failed stage-out', 'failed replica' );

my %opts = ( S => 0 );
my $tmpdir = $ENV{TMPDIR} || $ENV{TMP} || $ENV{TEMP} || 
    File::Spec->tmpdir() || '/tmp';
GetOptions( 'help|h|?' => sub { $opts{h}=1 },
	    'offset|a=i' => sub { $opts{a}=$_[1] },
	    'base|b=s' => sub { $opts{b}=$_[1] },
	    'debug|d=o' => sub { $opts{d}=$_[1] },
	    'dag|dagfile|D=s' => sub { $opts{D}=$_[1] },
	    'eps|e' => sub { warn "Option -e has been deprecated, ignoring\n" },
	    'omit|g=o' => sub { $opts{g}=$_[1] },
	    'keep|k' => sub { $opts{k}=1 },
	    'kickstart|K' => sub { $opts{K}=1 },
	    'log|l=s' => sub { $opts{l}=$_[1] },
	    'ypic|o=s' => sub { $opts{o}=$_[1] },
	    'zpic|O=s' => sub { $opts{O}=$_[1] },
	    'ploticus|p' => sub { $opts{p}=1 },
	    'png|P' => sub { $opts{P} = 1 },
	    'use-site|S=i' => sub { $opts{S}=$_[1]+0 },
	    'ytitle|t=s' => sub { $opts{t}=$_[1] },
	    'ztitle|T=s' => sub { $opts{T}=$_[1] },
	    'tmpdir=s' => \$tmpdir );

if ( exists $opts{h} || ! exists $opts{D} ) {
    my $base = basename($0,'.pl');
    print << "EOF";

Usage: $base [-d level] -D dagfile [-b basedir] [-o ypic] [-O zpic] [-p [-P]]

 -a|--offset s  use the time zone offset in seconds for non-local logs
 -b|--base dir  specifies the dir where DAG was started, default dirname(dagfn)
 -d|--debug lvl logical OR of the following levels, default is no debugging
    0x01:\treport job types and job names correlation.
    0x02:\treport data for each job tag.
    0x04:\treport \%dbase data structure composition for ypic
    0x08:\treport \%host data structure composition for zpic
    0x10:\tdump composed data structure, iff combined with any previous two
    0x20:\tshow details on the auto-scaling
    0x40:\treport files that were accessed.
    0x80:\tadd debug message to XML parser. 
 -D|--dag fn    specifies the Condor DAGMan dag file to parse, mandatory option
 -g|--omit lvl  tomit the gridstart gray boxes in the output, default draw
    0x01:\tomit gridstart gray boxes from ypic
    0x02:\tomit gridstart gray boxes from zpic
 -k|--keep      if set, keep the temporary files in /tmp, and don\'t remove
 -K|--kickstart parallelize zpic from kickstart intervals, default is Condor
 -l|--log fn    Condor\'s common user log, if in a non-standard location
 -o|--ypic fn   specifies the jobnr picture, default is ypic.eps
 -O|--zpic fn   specifies the host picture, default is zpic.eps
 -P|--png       Use ImageMagick\'s convert to create PNG from EPS files.
 -p|--ploticus  try to post-process with ploticus to EPS, default is not
 -S|--use-site  0: use gatekeeper host (default)
                1: use site handle 
	        2: use reported workernode handle
 -t|--ytitle t  title phrase on top of ypic - and zpic in absence of -T
 -T|--ztitle t  title phrase on top of zpic, default is timestamp/user
 --tmpdir dir   which directory to use for /tmp. Default is complex...

EOF
    exit 0;
}

if ( $opts{d} ) {
    foreach my $i ( qw(a b d D e g k K l o O p P t T S) ) {
	print "## option $i is $opts{$i}\n" 
	    if ( defined $opts{$i} && exists $opts{$i} );
    }
}

# globals
%main::dag = ();
$main::debug = ungarble($opts{d});
$main::year = (localtime())[5];
$main::min = $main::gridmin = 1E12;
$main::max = $main::gridmax = -1E12;

END {
    # big clean-up handler
    unlink( @main::unlink ) if @main::unlink > 0;
}

my @y=File::Temp->tempfile( 'ydata-XXXXX', DIR => $tmpdir, SUFFIX => '.dat' );
die "ERROR: Unable to create transient ydata file" unless defined $y[0]; 
my @z=File::Temp->tempfile( 'zdata-XXXXX', DIR => $tmpdir, SUFFIX => '.dat' );
die "ERROR: Unable to create transient zdata file" unless defined $z[0]; 

my $ypic = $y[1];
my $zpic = $z[1];
push( @main::unlink, $y[1], $z[1] ) unless $opts{k};

$opts{o}=File::Spec->catfile( File::Spec->curdir, "ypic.eps" )
    unless $opts{o};
$opts{O}=File::Spec->catfile( File::Spec->curdir, "zpic.eps" )
    unless $opts{O};

my $dagfn = $opts{D};
my $basedir = $opts{b} ? $opts{b} : dirname($opts{D});
die "Need a base directory to find submit files\n" unless -d $basedir;

# read .dag file to associate job ID <=> submit file
my ($subfn,$logfn);
open( DAG, "<$dagfn" ) || die "open $dagfn: $!\n";
warn "# reading $dagfn...\n" if ( $main::debug & 0x40 );
while ( <DAG> ) {
    $main::dag{$1} = $subfn = $2 if ( /^\s*job\s+(\S+)\s+(\S+)/i );
}
close DAG;

# read any submit file to find location of logfile common to all submit files
$subfn = File::Spec->catfile( $basedir, $subfn );
open( SUB, "<$subfn" ) || die "open $subfn: $!\n";
warn "# reading $subfn...\n" if ( $main::debug & 0x40 );
while ( <SUB> ) {
    $logfn = $1 if /^\s*log\s*=\s*(\S+)/;
}
close SUB;
undef $subfn;

if ( exists $opts{l} ) {
    $logfn = $opts{l};
} elsif ( ! -r $logfn ) {
    my $dagbase = basename( $dagfn );
    $dagbase =~ s/(?:\.(?:rescue|dag))+$//;
    $logfn = File::Spec->catfile( $basedir, $dagbase . '.log' );
}
$logfn = File::Spec->rel2abs( $logfn, $basedir )
    unless -r $logfn;
die "Unable to read Condor's common log $logfn\n"
    unless -r $logfn;
print "# dagfn=$dagfn\n# basedir=$basedir\n# logfn=$logfn\n" if $main::debug;

sub mytime ($$) {
    my ($month,$day) = split(/\//,shift());
    my ($h,$m,$s) = split(/:/,shift());
    my $r = timelocal($s,$m,$h,$day,$month-1,$main::year);
    $r += $opts{a} if exists $opts{a};
    $main::min = $r if $r < $main::min;
    $main::max = $r if $r > $main::max;
    $r;
}

sub graphics($$$$$) {
    my ($datafn,$outfn,$width,$height,$count,$ok,@arg) = @_;
    $width = sprintf("%.2f",$width+1);
    $height = sprintf("%.2f",$height);

    my $ploticus = find_exec('ploticus') || find_exec('pl');
    my $convert = find_exec('convert'); 
    if ( defined $ploticus ) {
	my $pos = rindex( $datafn, '.' );
	my $plsfn = ($pos >= 0 ? substr($datafn,0,$pos) : $datafn) . '.pls';
	@arg = ( $ploticus, $plsfn, '-eps' );
	# @arg = ( $ploticus, $plsfn, '-jpeg', '-pagesize', "$width,$height" );
	push( @arg, '-maxrows', $count+1, '-cpulimit', 600 ) if $count > 9999;

	warn "# running @arg\n"; # if $main::debug;
	system { $arg[0] } @arg;
	if ( $? == 0 ) {
	    my $fn = ($pos >= 0 ? substr($datafn,0,$pos) : $datafn) . '.eps'; 
	    @arg = ( '/bin/mv', '-f', $fn, $outfn );
	    warn "# running @arg\n"; # if $main::debug;
	    system { $arg[0] } @arg;

	    if ( $? == 0 ) { 
		if ( defined $convert ) { 
		    @arg = ( $convert, '-density', '96x96', 
			     '-background', 'white', '-flatten' ); 
		    $fn = basename($outfn,('.eps','.png','.jpeg'));
		    push( @arg, $outfn, File::Spec->catfile( dirname($outfn), $fn.".png" ) ); 

		    warn "# running @arg\n"; # if $main::debug;
		    system { $arg[0] } @arg;
		    warn( "Warning: @arg returned ", ($?>>8), '/', ($? & 127), "\n" )
			if $?;
		}
	    } else {
		warn( "Warning: @arg returned ", ($?>>8), '/', ($? & 127), "\n" );
	    }
	} else { 
	    warn( "Warning: @arg returned ", ($?>>8), '/', ($? & 127), "\n" );
	}
    } else {
	warn "# unable to run ploticus: executable not found\n";
    }
    $ok;
}

sub gridstart ($) {
    # purpose: parse a provenance tracking record
    # paramtr: $jobid (IN): job ID to determine the filename from
    # globals: $main::gridmin, $main::gridmax: min and max ks timestamps
    # globals: $final: greatest timestamp encountered
    # returns: array of hash with several important values
    #          host, start, duration, name (TR), raw status, exit
    my $jobid = shift;
    my @result = ();
    my $kfn = File::Spec->catfile( $basedir, $main::dag{$jobid} );
    substr( $kfn, -4 ) = '.out'; # s/sub$/out/ # FIXME: t'is a guess

    my @backup = sort glob( "$kfn.???" ); # new style
    @backup = ( $kfn ) if @backup == 0; # old style

    local($/) = "\n";
    foreach my $fn ( @backup ) {
	log( "reading kickstart $fn" ) if ( $main::debug > 1 );
	my @xml = ();
	if ( -r $fn && -s _ && open( KS, "<$fn" ) ) {
	    my $state = 0;
	    my $tmp = '';
	    while ( <KS> ) {
		if ( $state == 0 ) {
		    next unless m{^\s*<invocation\s};
		    $state = 1;
		    $tmp .= $_;
		} elsif ( $state == 1 ) {
		    $tmp .= $_;
		    if ( m{^\s*</invocation>} ) {
			$state = 0;
			push( @xml, $tmp );
			$tmp = '';
		    }
		}
	    }
	    close KS;
	    log( "found ", @xml+0, " invocation records" ) if $main::debug > 1;
	} else {
	    warn "Warning: Unable to read from $fn\n";
	}

	foreach my $xml ( @xml ) {
	    my @stack = ();
	    my %result = ();
	    my $parser = new XML::Parser::Expat( 'Namespaces' => 1 ) ||
		die "ERROR: Unable to instantiate an XML parser\n";
	    $parser->setHandlers( 'Start' => sub {
		my $self = shift;
		my $element = shift;
		my %attr = @_;
		push( @stack, $element );
		# warn '# ', join('/',@stack), "\n" if ( $main::debug & 0x80 );
		if ( @stack == 1 && $element ne 'invocation' ) {
		    die "ERROR: Wrong kind of XML input file\n";
		} elsif ( @stack == 1 && $element eq 'invocation' ) {
		    $result{host} = $attr{hostname} || $attr{hostaddr};
		    $result{start} = iso2unix( $attr{start} );
		    $result{duration} = $attr{duration};
		    $result{final} = $result{start} + $attr{duration};
		    $result{name} = $attr{transformation};
		} elsif ( @stack == 3 && $stack[1] =~ /job$/ && $element eq 'status' ) {
		    $result{raw} = $attr{raw};
		}
	    }, 'End' => sub {
		my $self = shift;
		my $element = shift;
		pop(@stack) eq $element;
	    }, 'Char' => sub {
		1;
	    } );

	    my $result;
	    eval { $result = $parser->parse($xml) };
	    if ( defined $result ) {
		# generic info post-processing
		$main::gridmin = $result{start} if $result{start} < $main::gridmin;
		$main::gridmax = $result{final} if $result{final} > $main::gridmax;
		push( @result, { %result } );
	    } else {
		warn "# unable to parse $fn\n";
	    }
	    
	    if ( $main::debug & 0x80 ) {
		warn "## XML from $fn\n";
		while ( my ($k,$v) = each %result ) {
		    warn "## $k = $v\n";
		}
	    }
	}
    }

    @result;
}

sub node_type ($) {
    # purpose: Determine the type of the node
    # paramtr: $subfn (IN): submit file (node) name
    # returns: a node type number
    # 0   unknown/error
    # 1   worker
    # 2   stage-in
    # 3   stage-out
    # 4   rc job
    # 5   inter-pool
    my $result = 0;		# to err is default
    my $subfn = File::Spec->catfile( $basedir, $_[0] );

    if ( open( SUB, "<$subfn" ) ) {
	warn "# reading $subfn...\n" if ( $main::debug & 0x40 );
	# search for ClassAd with job type
	while ( <SUB> ) {
	    $result=$1 if /^\s*\+(?:pegasus|vds)_job_class\s*=\s*(\S+)/; 
	}
	close SUB;
	goto GUESS if ( $result <= 0 );
	$result=0 if ( $result > 5 );
    } else {
	# make an educated guess
      GUESS:
	local($_) = basename($subfn);
	if ( /^stage_in_/ ) {
	    # stage-in job
	    $result = 2;
	} elsif ( /^stage_out_/ ) {
	    # stage-out job
	    $result = 3;
	} elsif ( /^register_/ ) {
	    # replica mgmt job
	    $result = 4;
	} elsif ( /^stage_inter_/ ) {
	    # inter pool transfer
	    $result = 5;
	} elsif ( /\S+/ ) {
	    # worker job
	    $result = 1;
	}
    }

    warn "# assigning jobtype $result to $_[0]\n" if ( $main::debug & 0x01 );
    $result;
}

sub read_site ($) {
    # purpose: Determine the resource handle from info in the submit file
    # paramtr: $jobid (IN)
    # returns: a site handle, if possible
    my $jobid = shift;
    my $subfn = File::Spec->catfile( $basedir, $main::dag{$jobid} );

    my $result;
    local(*SUB);
    local($/) = "\n";
    if ( open( SUB, "<$subfn" ) ) {
	warn "# reading $subfn...\n" if ( $main::debug & 0x40 );
	while ( <SUB> ) {
	    if ( /^\s*\+(vds_|wf_|pegasus_){1,2}site\s*=\s*(\S+)/i ) {
		$result = $2;
		my $first = substr($result,0,1);
		$result = substr($result,1,-1)
		    if ( $first eq "\'" || $first eq '"' );
		last if length($result);
	    }
	}
	close SUB;
    } else {
	warn "# unable to read $subfn: $!\n";
    }

    warn "# assigning site=$result\n" if ( $main::debug & 0x01 );
    $result;
}

    

my (%jobid,$jobid);
sub xlate($) {
    my $id=shift;
    if ( exists $jobid{$id} ) {
	$jobid{$id};
    } else {
	$jobid{$id} = ++$jobid;
    }
}

sub read_log ($\%\%\%) {
    my $logfn = shift;		# name of logfile
    my $dbaseref = shift;	# ref to dbase hash
    my $realhost = shift;
    my $warnings = shift;

    open( LOG, "<$logfn" ) or die "reading $logfn: $!\n";
    ## warn "# reading $logfn...\n" if ( $main::debug & 0x40 );
    my ($lastname,%dbase,%host,$tag,%warn,@stat,$ipv4,$node,$site,$rc);
    $/="\n...\n";
    while ( <LOG> ) {
	if ( /\# DONE/ or eof(LOG) ) {
	    $main::done=1;
	    last unless /\.\.\.[\r\n]*$/;
	}
	$_ = substr($_,index($_,"\n")+1) while ( ! /^0/ && length );
	next unless length;

	if ( /^(\d{3}) \((\d+)[0-9.]+\) ([0-9\/]+) ([0-9:]+)/ ) {
	    $tag = $1;
	    my $job = xlate($2); 
	    my $tds = mytime($3,$4);

	    if ( $tag eq '000' ) {
		# submission notice
		# [ stamp, SH_ipv4, dagnodeid, nodetype ]
		/((?:\d{1,3}\.){3}\d{1,3})/ ? $ipv4=$1 : undef $ipv4;
		/DAG Node:\s(\S+)/ ? $node=$1 : undef $node;
		/pool:(\S+)/ ? $site=$1 : undef $site;
		$dbase{$job}{$tag} = [ $tds, $ipv4, $node, node_type($node), $site ];
		warn "# ($job,$tag)=($tds,$ipv4,$node,$site)\n" 
		    if ( $main::debug & 0x02 );
	    } elsif ( $tag eq '001' ) {
		# execution notice
		# [ stamp, GK_host ]
		my $host;
		if ( /: gt. (\S+)/ ) {
		    my @a = split /\//, $1;
		    $host = ( @a > 3 ? $a[2] : $a[0] );
		    $dbase{$job}{$tag} = [ $tds, $host ];
		    warn "# ($job,$tag)=($tds,$host)\n" 
			if ( $main::debug & 0x02 );
		} elsif ( /((?:\d{1,3}\.){3}\d{1,3})/ ) {
		    $host = $1;
		    $dbase{$job}{$tag} = [ $tds, $host ];
		    warn "# ($job,$tag)=($tds,$host)\n" 
			if ( $main::debug & 0x02 );
		} elsif ( /: (\S+)/ ) {
		    $host = $1; # inet_ntoa(inet_aton($1));
		    $dbase{$job}{$tag} = [ $tds, $host ];
		    warn "# ($job,$tag)=($tds,$host)\n" 
			if ( $main::debug & 0x02 );
		} else {
		    warn "# unable to extract hostname for $tag/$job/$tds!\n";
		}

	    } elsif ( $tag eq '017' || $tag eq '027' ) {
		# job was sumitted to Globus or Grid
		# [ stamp, GK_host ]
		if ( /RM-Contact:\s+(\S+)/ ) {
		    my @a = split /\//, $1;
		    my $host = ( @a > 3 ? $a[2] : $a[0] );
		    $dbase{$job}{'017'} = [ $tds, $host ];
		    warn "# ($job,$tag)=($tds,$host)\n" 
			if ( $main::debug & 0x02 );
		} elsif ( /GridResource:\s+\S+\s+(\S+)/ ) { 
		    my @a = split /\//, $1;
		    my $host = ( @a > 3 ? $a[2] : $a[0] );
		    $dbase{$job}{'017'} = [ $tds, $host ];
		    warn "# ($job,$tag)=($tds,$host)\n" 
			if ( $main::debug & 0x02 );		    
		} else {
		    warn "# unable to extract hostname for $tag/$job/$tds\n";
		}
	    } elsif ( $tag eq '005' ) {
		# result
		# [ stamp, result, start, duration, WN_ipv4, exitcode [, site ] ]
		/\(return value (-?\d+)/ ? $rc=$1 : undef $rc;
		my @y = ($tds,$rc,1E20,0);
		if ( defined $dbase{$job}{'000'}->[2] ) {
		    my @x = gridstart($dbase{$job}{'000'}->[2]);
		    foreach my $x ( @x ) {
			if ( $x->{start} >= 1000000000 ) {
			    ## push( @y, @x{'start','duration','host','exit'} );
			    $y[2] = $x->{start} if $y[2] > $x->{start};
			    $y[3] += $x->{duration};
			    $y[4] = $x->{host};

			    # set failure mode from true exit code
			    $y[1] = $x->{rawexit} == 0 ? 0 : 1 if ( $y[1] == 0 );
			    $main::duration{total} += $x->{duration};
			    if ( $y[1] ) {
				$main::duration{bad} += $x->{duration};
			    } else {
				$main::duration{good} += $x->{duration};
			    }
			}
		    }
		}
		if ( abs($y[2] - 1E20) < 100 ) { 
		    # Ayieeh, no sane data, @y is still defaults
		    $y[2] = $tds;
		    $y[3] = 0; 
		}
		$dbase{$job}{$tag} = [ @y ];
		$stat[$y[1] ? 0 : $dbase{$job}{'000'}->[3]]++;

		warn "# ($job,$tag)=(", join(',',@y), ")\n" 
		    if ( $main::debug & 0x02 );
	    } elsif ( $tag eq '016' ) {
		# post script -- Euryale
		/\(return value (-?\d+)/ ? $rc=$1 : undef $rc;
		my @y = @{$dbase{$job}{'005'}};
		if ( $rc ) {
		    # error case
		    $dbase{$job}{'005'} = [ $y[0], 1 ];
		    $main::duration{good} -= $y[3];
		    $main::duration{bad} += $y[3];
		    $stat[0]++;
		    $stat[$dbase{$job}{'000'}[3]]--;
		} else {
		    # good case
		    my ($node,$site);
		    if ( defined ($node = $dbase{$job}{'000'}[2]) ) {
			$site = $dbase{$job}{'000'}[4] || read_site($node);
			if ( defined $site ) {
			    $dbase{$job}{'001'}[2] = $site;
			    $dbase{$job}{'005'}[7] = $site;
			}
		    }
		}
		warn "# ($job,$tag)=(", join(',',@y), ")\n" 
		    if ( $main::debug & 0x02 );

	    } elsif ( $tag eq '009' ) {
		# manual job removal?
		# 009 (1870.000.000) 11/09 17:51:17 Job was aborted by the user.
		# via condor_rm (by user voeckler)
		# mark as bad in 005
		# [ stamp, result, start, duration, WN_ipv4, exitcode [, site ] ]
		# mark as bad in 001
		# [ stamp, GK_host [, site ] ]
		my $gk = $dbase{$job}{'017'}[1];
		$dbase{$job}{'001'} = [ $tds, $gk || 'unsubmitted', undef ] 
		    unless exists $dbase{$job}{'001'};
		$dbase{$job}{'005'} = [ $tds, 1, undef, undef, undef, -1 ];
		#$main::duration{good} -= $y[3];
		#$main::duration{bad} += $y[3];
		$stat[0]++;
		#$stat[$dbase{$job}{'000'}[3]]--;
		warn "# ($job,$tag)=($tds)\n" if ( $main::debug & 0x02 );

	    } else {
		# unknown
	    }
	    $warn{$tag}++;
	}
	last if $main::done;
    }
    close(LOG);

    print "# post-processing...\n";
    my $sometime = $main::max - $main::min + 10;
    foreach my $i ( keys %dbase ) {
	# substract base time
	foreach my $x ( qw(000 001 005) ) {
	    if ( exists $dbase{$i}->{$x} ) {
		$dbase{$i}{$x}->[0] -= $main::min;
	    } else {
		warn "# removing unfinished job $i\n";
		delete $dbase{$i};
		last;
		# $dbase{$i}{$x}->[0] = $sometime;
	    }
	}
	if ( exists $dbase{$i} && exists $dbase{$i}->{'005'} ) {
	    $dbase{$i}{'005'}->[2] -= $main::min
		if defined $dbase{$i}{'005'}->[2];
	}
    }

    foreach my $i ( keys %dbase ) {
	# prepare stage2
	if ( exists $dbase{$i}->{'001'} ) {
#	    my $host = ( defined $dbase{$i}{'005'}->[4] ) ?
#		$dbase{$i}{'005'}->[4] : # WN_ipv4
#		$dbase{$i}{'001'}->[1];  # GK_host
#	    my $host = $dbase{$i}{'001'}->[2] ? 
#		$dbase{$i}{'001'}->[2] : $dbase{$i}{'001'}->[1];
	    my $host = 'unknown';
	    if ( $opts{S} == 1 ) {
		$host = $dbase{$i}{'001'}->[2]; # site handle
	    } elsif ( $opts{S} == 2 ) {
		$host = $dbase{$i}{'005'}->[4]; # WN host
	    } else {
		$host = $dbase{$i}{'001'}->[1]; # gatekeeper host
	    }

	    push( @{$host{$host}}, 
		  $rc = [ $dbase{$i}{'001'}->[0],
		    $dbase{$i}{'000'}->[0],
		    $dbase{$i}{'005'}->[0],
		    $dbase{$i}{'005'}->[1], # exit code
		    $dbase{$i}{'000'}->[3], # kind of job
		    $dbase{$i}{'005'}->[2], 
		    $dbase{$i}{'005'}->[2] + $dbase{$i}{'005'}->[3] ] );
	    warn "# ypic: (", join(',',@$rc), ")\n" if ( $main::debug & 0x04 );
	}
    }
    warn "# ypic: ", Data::Dumper->Dump([\%dbase], [qw(%dbase)]), "\n"
	if ( ($main::debug & 0x14) == 0x14 );

    #!!my ($lo,$hi) = 0 ? (0,2) : (5,6);
    my ($lo,$hi) = $opts{K} ? (5,6) : (1,2);

    my %real;
    foreach my $host ( sort { $a cmp $b } keys %host ) {
	my @list = sort { $a->[$lo] <=> $b->[$lo] } @{$host{$host}};
	unshift( @{$real{$host}->[0]}, $rc = $list[0] );
	warn "# zpic: (", join(',',@$rc), ")\n" if ( $main::debug & 0x08 );
	for ( my $i=1; $i<@list; $i++ ) {
	    my ($j,$k);
	    if ( $list[$i]->[$lo] < $list[$i-1]->[$hi] && $list[$i]->[$lo] >= 0 ) {
		# overlap detected
		$j++ while ( $list[$i]->[$lo] < $real{$host}->[$j]->[0]->[$hi] );
	    }
	    if ( $list[$i]->[2] ) {
		unshift( @{$real{$host}->[$j]}, $rc=$list[$i] );
		warn "# zpic: (", join(',',@$rc), ")\n" 
		    if ( $main::debug & 0x08 );
	    }
	}
    }
    warn "# zpic: ", Data::Dumper->Dump([\%host], [qw(%host)]), "\n"
	if ( ($main::debug & 0x18) == 0x18 );

    # return results in call-by-ref vars
    %{$dbaseref} = %dbase;
    %{$realhost} = %real;
    %{$warnings} = %warn;

    # return stats as result
    @stat;
}

sub xtime ($$) {
    defined $_[0] ? $_[0] : $_[1];
}

sub write_ypic_data ($\%) {
    my $fn = shift;
    my %dbase = %{shift()};

    my @x = sort { $a <=> $b } keys %dbase;
    my $sometime = time - $main::min;
    my $df1 = new IO::File ">$fn" || die "open $fn: $!\n";
    foreach my $i ( @x ) {
	my @y = ( xtime($dbase{$i}{'001'}->[0], $sometime),
		  $i - $x[0] + 1,
		  xtime($dbase{$i}{'000'}->[0], $sometime), 
		  xtime($dbase{$i}{'005'}->[0], $sometime),
		  $dbase{$i}{'005'}->[1],
		  $dbase{$i}{'000'}->[3] );
	$df1->printf( "%5d %5d %5d %5d %d %d", @y );
	warn "# ypic: ($i)=(", join(',',@y), ")\n"
	    if ( $main::debug & 0x04 );

	if ( my $x = $dbase{$i}{'005'}->[2] ) {
	    $df1->printf( " %9.3f %9.3f\n", $x, $x+$dbase{$i}{'005'}->[3] );
	} else {
	    $df1->print(" \"\" \"\"\n");
	}
    }
    $df1->close();

    # return all job ids as result
    @x;
}

sub write_ypic_ploticus ($$$$\$\$\$\$\$\$) {
    my $ypic = shift;
    my $mint = shift;
    my $maxt = shift;
    my $jobs = shift;		# number of jobnumbers
    my ($upperx,$uppery,$xstub,$xtics,$ystub,$ytics) = @_;

    my $deftitle = default_title($dagfn,$main::min);
    my $title = $opts{t} || $deftitle;

    my $pos = rindex($ypic,'.');
    my $fn = ($pos >= 0 ? substr($ypic,0,$pos) : $ypic) . '.pls';
    push( @main::unlink, $fn ) unless $opts{k};
    print "# generating plotticus driver $fn...\n";

    if ( open( OUT, ">$fn" ) ) {
	warn "# writing $fn...\n" if ( $main::debug & 0x40 );
	# phase 1: basic scaling
	$$upperx = ($maxt - $mint) / 60.0;
	warn "# phase0: diff_t=", $$upperx, "\n"
	    if ( ($main::debug & 0x20) == 0x20 );

	$$upperx = 4.0 if ( $$upperx < 4 );
	$$uppery = $jobs / 13.0;
	$$uppery = 2.0 if ( $$uppery < 2 );
	warn( "# phase1: upperx=", $$upperx, ", uppery=", $$uppery,
	      ", div=", sprintf("%.3f",$$upperx / $$uppery), "\n" )
	    if ( ($main::debug & 0x20) == 0x20 );

	# phase 2: extreme imbalance adjustments
	$$xtics = 10;
	$$xstub = 60;
	while ( $$upperx > 20 ) {
	    warn( "# extreme x-scaling [", 
		  join(",",$$upperx,$$xtics,$$xstub), "]\n" );
	    $$upperx /= 5;
	    $$xtics *= 5;
	    $$xstub *= 5;
	}
	$$upperx = 4.0 if ( $$upperx < 4 );
	warn( "# phase2a: upperx=", $$upperx, ", uppery=", $$uppery,
	      ", div=", sprintf("%.3f",$$upperx / $$uppery), "\n" )
	    if ( ($main::debug & 0x20) == 0x20 );

#	$$ytics = 1; 
#	$$ystub = 5;
#	while ( ($$uppery / $$upperx) > 5 ) {
#	    warn "# extreme y-scaling\n";
#	    $$uppery /= 5;
#	    $$ytics *= 5;
#	    $$ystub *= 5;
#	}
#	$$uppery = 2.0 if ( $$uppery < 2 );
#	warn "# phase2b: upperx=", $$upperx, ", uppery=", $$uppery,"\n" 
#	    if ( ($main::debug & 0x20) == 0x20 );

	# phase 3: large number adjustments
	for ( my $x = $$upperx; $x > 30; $x /= 10 ) {
	    warn "# large number x-adjustment\n";
	    $$xtics *= 10;
	    $$xstub *= 10;
	}
	for ( my $y = $$uppery; $y > 40; $y /= 10 ) {
	    warn "# large number y-adjustment\n";
	    $$ytics *= 10;
	    $$ystub *= 10;
	}

	print OUT << "END"
//
// generated: $deftitle
//
#proc getdata
  file: $ypic

#proc areadef
  rectangle 0.5 0.5 @{[sprintf("%.1f",$$upperx)]} @{[sprintf("%.1f",$$uppery)]}
  xautorange: datafields=1,3,4
  yautorange: datafield=2
  frame: width=0.5 color=gray(0.3)
  title: $title
  titledetails: align=C style=I 
// adjust=0,0.2 // size=18

#proc xaxis
  ticincrement: $$xtics
  grid: color=rgb(1,0.9,0.8) style=1 dashscale=2

#proc xaxis
  label: Jobs over Time
  tics: yes
  stubs: incremental $$xstub
  minorticinc: $$xtics
  grid: color=gray(0.8)

#proc yaxis
  ticincrement: $$ytics
  grid: color=rgb(1,0.9,0.8) style=1 dashscale=2

#proc yaxis
//  label: job [#]
  tics: yes
  stubs: incremental $$ystub
  minorticinc: $$ytics
  grid: color=gray(0.8)

#proc legendentry
  sampletype: color
  label: Worker job
  details: green
  tag: 1

#proc legendentry
  sampletype: color
  label: Stage-in job
  details: skyblue
  tag: 2

#proc legendentry
  sampletype: color
  label: Stage-out job
  details: lightpurple
  tag: 3

#proc legendentry
  sampletype: color
  label: Replica job
  details: yellow2
  tag: 4

#proc legendentry
  sampletype: color
  label: Interpool Xfer
  details: pink
  tag: 5

#proc legendentry
  sampletype: color
  label: Unknown job
  details: red
  tag: 0

#proc legendentry
  sampletype: symbol
  label: GridStart info
  details: shape=square style=outline linecolor=gray(0.4) fillcolor=gray(0.75)

// output boxes without errors
#proc bars
  select: \@5 = 0
  outline: no
  barwidth: 0.03
  horizontalbars: yes
  segmentfields: 3 4
  locfield: 2
  colorfield: 6
  tails: 0.03

// output boxes with errors
#proc bars
  select: \@5 != 0
  outline: color=redorange width=0.8
  barwidth: 0.03
  horizontalbars: yes
  segmentfields: 3 4
  locfield: 2
//  colorfield: 6
  color: red
  tails: 0.03

END
;
      if ( ($opts{g} & 0x01) == 0 ) {
	  # print gridstart gray boxes
	  print OUT << "END"
// gray gridstart boxes
#proc bars
  select: \@5 = 0
  outline: color=gray(0.4)
  color: gray(0.75)
  horizontalbars: yes
  barwidth: 0.04
  tails: no
  segmentfields: 7 8
  locfield: 2

END
;
      }
	print OUT << "END"
// execution cross
#proc scatterplot
  select: \@5 = 0
  xfield: 1
  yfield: 2
  symbol: shape=square style=spokes linecolor=black

#proc legend
  format: multiline
  location: min+0.5 max

END
;
	close(OUT);
    } else {
	warn "unable to generate $fn: $!\n";
    }
}

sub write_zpic_data ($\%) {
    my $fn = shift;
    my %host = %{shift()};

    my @host = sort { inet_aton($b) cmp inet_aton($a) } keys %host;
    my $df1 = new IO::File ">$fn" || die "open $fn: $!\n";
    # collect y-axis into extra file
    my $df2 = new IO::File ">${fn}2" || die "open ${fn}2: $!\n";
    push( @main::unlink, "${fn}2" ) unless $opts{k};

    my %done;
    my $count=1;
#   my $skip = int( POSIX::ceil( @host / 20.0 ) );
    foreach my $host ( @host ) {
	warn "# zpic: processing $host\n" if ( $main::debug & 0x08 );
	for ( my $i=0; $i<@{$host{$host}}; $i++ ) {
	    for ( my $j=@{$host{$host}->[$i]}-1; $j >= 0; $j-- ) {
		my $x = $host{$host}->[$i]->[$j];
		print '.', next if ( $x->[5] < 0 && $x->[6] < 0 );
		warn "# zpic: ($host,$i,$j)=(", join(',',@$x), ")\n"
		    if ( $main::debug & 0x08 );
		
		if ( defined $x->[1] ) {
		    if ( $done{$host} < $count+$i ) {
			if ( @{$host{$host}} == 1 ) {
			    $df2->printf( "%4u %s\n", $count+$i, $host );
#				      ($count % $skip) == 0 ? $host : "" );
			} else {
			    $df2->printf( "%4u %s:%d\n", $count+$i, $host, $i );
#				      ($count % $skip) == 0 ? $host : "" );
			}
			$done{$host} = $count+$i;
		    }

		    $df1->printf( "%5d %4u %5d %5d %d %d", 
				  $x->[0], $count+$i, @$x[1..4] );
		    if ( $x->[5] ) {
			$df1->printf( " %9.3f %9.3f\n", $x->[5], $x->[6] );
		    } else {
			$df1->print( " \"\" \"\"\n" );
		    }
		}
	    }
	}
	$count += @{$host{$host}};
    }
    $df2->close();
    $df1->close();

    # return host count as result
    $count-1;
}

sub write_zpic_ploticus ($$\$\$\$\$) {
    my $zpic = shift;
    my $hostcount = shift;	# number of hosts
    my ($upperx,$uppery,$xstub,$xtics) = @_;

    my $deftitle = default_title($dagfn,$main::min);
    my $title = $opts{T} || $opts{t} || $deftitle;
    my $pos = rindex($zpic,'.');
    my $fn = ($pos >= 0 ? substr($zpic,0,$pos) : $zpic) . '.pls';
    push( @main::unlink, $fn ) unless $opts{k};
    print "# generating plotticus driver $fn...\n";
    if ( open( OUT, ">$fn" ) ) {
	# keep x scaling from last diagram!
	warn "# writing $fn...\n" if ( $main::debug & 0x40 );
	$$uppery = $hostcount / 4.0;
#!!	$$uppery /= 5 while ( $$uppery > 20 );
	$$uppery = 2.0 if ( $$uppery < 2 );

	$$upperx = 8.0 if $main::duration{total} > 14400;

    
    	warn "# zpic: upperx=", $$upperx, ", uppery=", $$uppery,"\n" 
	    if ( $main::debug & 0x20 );

	print OUT << "END"
//
// generated: $deftitle
//
#proc getdata
  file: $zpic

#proc areadef
  rectangle 2.5 0.5 @{[sprintf("%.1f",$$upperx+1.0)]} @{[sprintf("%.1f",$$uppery)]}
  xautorange: datafields=1,3,4
//  yscaletype: categories
//  ycategories: datafield=2
  yrange: 0 @{[$hostcount+1]}
  frame: width=0.5 color=gray(0.3)
  title: $title
  titledetails: align=C style=I
// size=18 // align=0,0.2

#proc xaxis
  ticincrement: $$xtics
  grid: color=rgb(1,0.9,0.8) style=1 dashscale=2

#proc xaxis
  label: Hosts over Time
  tics: yes
  stubs: incremental $$xstub
  minorticinc: $$xtics
  grid: color=gray(0.8)

#proc yaxis
//  stubs: categories
  selflocatingstubs: file ${zpic}2
  grid: color=gray(0.8)

#proc legendentry
  sampletype: color
  label: Worker job
  details: green
  tag: 1

#proc legendentry
  sampletype: color
  label: Stage-in job
  details: skyblue
  tag: 2

#proc legendentry
  sampletype: color
  label: Stage-out job
  details: lightpurple
  tag: 3

#proc legendentry
  sampletype: color
  label: Replica job
  details: yellow2
  tag: 4

#proc legendentry
  sampletype: color
  label: Interpool Xfer
  details: pink
  tag: 5

#proc legendentry
  sampletype: color
  label: Unknown job
  details: red
  tag: 0

#proc legendentry
  sampletype: symbol
  label: GridStart info
  details: shape=square style=outline linecolor=gray(0.4) fillcolor=gray(0.75)

// colored boxes for regular jobs
#proc bars
  select: \@5 = 0
  outline: no
  barwidth: 0.06
  tails: 0.06
  horizontalbars: yes
//!!  segmentfields: 1 4
  segmentfields: 3 4
  locfield: 2
  colorfield: 6

// red-framed boxes for failed jobs
#proc bars
  select: \@5 != 0
  outline: color=redorange width=1.44
  barwidth: 0.06
  tails: no
  horizontalbars: yes
//!!  segmentfields: 1 4
  segmentfields: 3 4
  locfield: 2
//  colorfield: 6
  color: red

END
;
	if ( ($opts{g} & 0x02) == 0 ) {
	    # print gridstart gray boxes
	    print OUT << "END"
// gray gridstart boxes
#proc bars
  select: \@5 = 0
  outline: color=gray(0.4)
  color: gray(0.75)
  horizontalbars: yes
  barwidth: 0.04
  tails: no
  segmentfields: 7 8
  locfield: 2

END
;
	}
	print OUT << "END"
// execution cross
#proc scatterplot
  select: \@5 = 0
  xfield: 1
  yfield: 2
  symbol: shape=square style=spokes linecolor=black

#proc legend
  format: multiline
  location: max+0.5 max

END
;
	close(OUT);
    } else {
	warn "unable to generate $fn: $!\n";
    }
}

#
# start main
#
undef $main::done;
my (%dbase,%real,%warn,$upperx,$uppery,$xstub,$xtics,$ystub,$ytics);

print "# reading $logfn...\n";
my @stat = read_log($logfn,%dbase,%real,%warn);

# is there anything to produce?
my $sum = 0;
for ( my $i=0; $i<=4; $i++ ) { $sum += $stat[$i]; }
if ( $sum == 0 ) {
    print "# no jobs - no pictures\n";
} else {
    print "# generating $ypic...\n";
    my @jobs = write_ypic_data($ypic,%dbase);
    write_ypic_ploticus($ypic,$main::min,$main::max,$#jobs,
			$upperx,$uppery,$xstub,$xtics,$ystub,$ytics);
    my @ypic = ($upperx+1,$uppery+0.2);

    print "# generating $zpic...\n";
    $upperx += 1.0;
    my $hostcount = write_zpic_data($zpic,%real);
    write_zpic_ploticus($zpic,$hostcount,$upperx,$uppery,$xstub,$xtics);
    my @zpic = ($upperx+2,$uppery+0.2);

    # time saver
    if ( exists $opts{p} ) {
	graphics($ypic,$opts{o},$ypic[0],$ypic[1],0+@jobs);
	graphics($zpic,$opts{O},$zpic[0],$zpic[1],$hostcount);
    }
}

print "\nTAG COUNT MESSAGE\n";
foreach my $tag ( sort %warn ) {
    printf( "%3s %5d %s\n", $tag, $warn{$tag}, $main::status{$tag}->[0] )
	if exists $warn{$tag};
}
print "\nTAG COUNT MESSAGE\n";
for ( my $i=0; $i<=4; $i++ ) {
    printf( " %2d %5d %s job%s\n", $i, $stat[$i], $main::statmsg[$i],
	    $stat[$i] == 1 ? "" : "s" );
}
printf "    %5d job%s total\n", $sum, $sum == 1 ? "" : "s";

print "\nSTATISTICS\n";
my $diff = $main::max - $main::min;
printf( "Condor: %s .. %s = %lu s\n", 
	unix2iso($main::min), unix2iso($main::max), $diff );
printf( "Launch: %s .. %s = %lu s\n", 
	unix2iso($main::gridmin), unix2iso($main::gridmax),
	$main::gridmax - $main::gridmin );
printf( "Duration: %.3f good + %.3f bad = %.3f s, speed-up %.2f\n", 
	@main::duration{'good','bad','total'}, $main::duration{total} / $diff );print "\n";

exit 0;