#!/usr/bin/perl -w
require 5.003;
use strict;

# plots traces labeled with label_results
# see also: label_results, report_results

if (`pwd` =~ 'ReportGen') {
	use lib '..';
}

use ReportGen::Opts;
use ReportGen::Globs;
use ReportGen::ObjDbase;
use ReportGen::ObjManip;

require ReportGen::Plot;
require ReportGen::Line;

# Configuration

my %Opts = (
	out_name => undef(),
	plot_title => undef(),
	plot_size => undef(),
	plotter_terminal => undef(),
	plotter => undef(),
	plotter_opts => undef(),
);
my %SavedOpts = %Opts;


# globals

my @ObjTags = ();  # objects to plot, label:name,name ...
my @Objs = ();     # objects to plot, {label,name,fname,pos} tuples
my @ObjLabels = ();
my @ObjTypes = ();

my $Stats = {}; # aggregate stats

my $Plot;
my $XScale = 1;

&init();
exit(&main());

sub main {

	foreach my $label (@ObjLabels) {
		$Stats->{$label} = &ReadDbase(&FullInFName($label, 'clt.All.lx'));
	}
	&scanObjs();

	$Plot = new ReportGen::Plot(join(' ', $0, @ARGV));

	&setXLabel();
	&setYLabels();
	&setTitle();
	&setOther();
	&addLines();

	&setTerminal($Opts{plotter_terminal});
	&setOutput($Opts{out_name});

	&plot();
	return 0;
}

sub scanObjs {
	my %labels = ();
	my %types = ();

	foreach my $tag (@ObjTags) {
		my ($label, $names) = ($tag =~ /^(\S+):(.*)$/);
		die(&usage()) unless $names;
		&curLabel($label);
		&addObjects();
		foreach my $name (split(/,/, $names)) {
			my $fname = &FullInFName($label, 'clt.Traces', '.lx');
			my $type = &ObjName2Type($name);
			die("$0: unknown object `$name'\n") unless $type;

			my $pos = &getObjPos($fname, $name);
			warn("$0: `$fname' has no object named `$name', skipping\n"), next
				unless defined $pos;

			my $obj = {
				label => $label,
				name => $name,
				type => $type,
				pos => $pos,
				fname => $fname,
			};

			push @Objs, $obj;

			push @ObjLabels, $label unless exists $labels{$label};
			push @ObjTypes, $type unless exists $types{$type};

			$labels{$label} = $obj;
			$types{$type} = $obj;
		}
		&curLabel(undef());
	}
}

sub setXLabel {
	my $max_dur = -1;
	foreach my $label (@ObjLabels) {
		my $dur = $Stats->{$label}->{duration}->{body};
		$max_dur = $dur if defined $dur && $max_dur < $dur;
	}

	if ($max_dur > 2*60*60) {
		$XScale = 60*60;
		$Plot->xlabel_qw('time (hours)');
	} else {
		$XScale = 60;
		$Plot->xlabel_qw('time (minutes)');
	}
}

sub setYLabels {
	if ( @ObjTypes > 2 ){
		$Plot->ylabel();
		$Plot->y2label();
		$Plot->noytics();
		$Plot->noy2tics();
	} else { # @ObjTypes <= 2
		$Plot->ylabel_qw($ObjTypes[0]) unless !@ObjTypes;
		if (@ObjTypes > 1) {
			$Plot->y2label_qw($ObjTypes[1]);
			$Plot->y2tics();
			$Plot->ytics('nomirror');
		}
	}
}

sub setTitle {
	my $title = $Opts{plot_title};
	if (!defined $title) {
		my @onames = ();
		# XXX: use importObjects instead and use human names everywhere
		if (@ObjLabels == 1) {
			my $label = $ObjLabels[0];
			my $facts = &ReadDbase(&FullInFName($label, 'facts.lx'), 'may_fail');
			&importObjects($facts, $label) if $facts;
			my $hname = &label2hname($label);
			@onames = map { $_->{name} } @Objs;
			$title = "$hname: ";
		} else {
			@onames = @ObjTags;
			$title = '';
		}
		$title = &fmtTitle($title, " vs. time", @onames);
	}
	$Plot->title($title);
}

sub setOther {
	$Plot->range('y', 0);
	$Plot->data('style lines');
	$Plot->grid();
	$Plot->timestamp();
	$Plot->size($Opts{plot_size}) if defined $Opts{plot_size};
}

sub addLines {
	for my $obj (@Objs) {
		my $line = new ReportGen::Line;
		my $ypos = $obj->{'pos'};
		$ypos = "\$$ypos" unless $ypos =~ /\$/;
		$line->data($obj->{fname});
		$line->using("\$1/$XScale", $ypos);
		if (@ObjLabels == 1) {
			$line->title($obj->{name});
		} else {
			$line->title($obj->{label}. ':'. $obj->{name});
		}
		$line->axes('x1y2') if
			$obj->{type} ne $ObjTypes[0] && @ObjTypes <= 2;
		$Plot->line($line);
	}
}

sub setTerminal {
	my $term = shift;
	$Plot->terminal($term) if $term;
}

sub setOutput {
	my $fname = shift;
	$Plot->output($fname) if defined $fname;
}

sub plot {
	if (my $fname = $Plot->ofile()) {
		warn("$0: plotting: `$fname'\n");
	}
	$Plot->plot();
}

sub getObjPos {
	my ($fname, $name) = @_;

	open(IF, "<$fname") or die("$0: cannot open `$fname': $!\n");
	my $firstLine = <IF>;
	close(IF);

	my @names = split(/\s+/, $firstLine);
	die("$0: `$fname' has unknown file format\n") 
		unless @names && $names[0] =~ s/^#//;

	my $pos = &findName($name, \@names);
	return $pos if defined $pos;

	#die("$0: `$fname' has no object named `$name'\n");
	return undef();
}

sub findName {
	my ($name, $names) = @_;

	my $pos = 1;
	foreach my $n (@{$names}) {
		return $pos if $n eq $name;
		$pos++;
	}

	# raw object is not found, see if the object is derived
	my $expr = &objExpr($name);
	return undef() unless defined $expr;

	$expr =~ s/([_a-zA-Z][\w\.]*)/&findNameAndFmt($1, $names)/eg;
	return undef() if $expr =~ /@@@/;

	return $expr;
}

sub fmtTitle {
	my ($prefix, $suffix, @names) = @_;
	my $extraLen = length($prefix) + length($suffix);
	my $title = '';
	while (@names && $extraLen + length($title) + length($names[0]) <= 75) {
		$title .= ' & ' if length($title);
		$title .= shift @names;
	}
	return "${prefix}${title}${suffix}";
}

sub findNameAndFmt {
	my ($name, $names) = @_;

	my $pos = &findName($name, $names);
	return '@@@' unless defined $pos;

	return sprintf('($%d)', $pos) if $pos =~ /^\d/;
	return "($pos)";
}

sub init {
	die(&usage()) unless &ParseOpts(\%Opts, \@ObjTags, @ARGV) && @ObjTags;
	die("plotter must be specified\n" . &usage()) unless $Opts{plotter};
	$ReportGen::Plot::Plotter = $Opts{plotter};
	$ReportGen::Plot::Plotter .= ' ' . $Opts{plotter_opts}
		if $Opts{plotter_opts};
}

sub usage {
	return "usage: $0 [options] <label:object[,object...]> ...\n" . &Opts2Str(\%SavedOpts);
}