#!/usr/bin/perl -w

use strict;

BEGIN {
    unshift(@INC, "lib") if -f "lib/PerlBench.pm";
}

use PerlBench::Utils qw(sec_f num_f);
use PerlBench::Stats qw(calc_stats);
use PerlBench::Results;
use Getopt::Long qw(GetOptions);

my $resdir = "perlbench-results";
my $merge;
my $filter_activeperl;
my $filter_gcc;
my $filter_nogcc;
my $filter_static;
my @filter_version;
my @filter_dir;
my $show_dir;
my $show_path;
GetOptions(
   'result-dir=s' 	=> \$resdir,
   'merge' 		=> \$merge,
   'filter-activeperl' 	=> \$filter_activeperl,
   'filter-gcc' 	=> \$filter_gcc,
   'filter-nogcc' 	=> \$filter_nogcc,
   'filter-static' 	=> \$filter_static,
   'filter-version=s' 	=> \@filter_version,
   'filter-dir=s' 	=> \@filter_dir,
   'show-dir' 		=> \$show_dir,
   'show-path' 		=> \$show_path,
) || usage();

my $cmd = shift || usage();
$cmd =~ s/-/_/g;
$cmd = "cmd_$cmd";
usage() unless defined &$cmd;

my $res = PerlBench::Results->new($resdir);
die "No results found in $resdir.\n" unless $res;

{
    no strict 'refs';
    &$cmd(@ARGV);
}

sub cmd_list_hosts {
    for my $h ($res->hosts) {
	print $h;
	if (my @perls = $res->perls($h)) {
	    my $t = 0;
	    for my $p (@perls) {
		$t += @{$p->{t}};
	    }
	    my $n = @perls;
	    printf " (%d result%s for %d perl%s)",
		$t, ($t == 1 ? "" : "s"),
		$n, ($n == 1 ? "" : "s");
	}
	print "\n";
    }
}

sub _filter_perl {
    my $perl = shift;
    return 0 if $filter_activeperl && !($perl->{name} =~ /ActivePerl/);
    return 0 if $filter_gcc && !$perl->{config}{gccversion};
    return 0 if $filter_nogcc && $perl->{config}{gccversion};
    return 0 if $filter_static && $perl->{config}{useshrplib} eq "true";
    if (@filter_version) {
	return 0 unless grep $perl->{version} =~ /^\Q$_\E(\.|$)/, @filter_version;
    }
    if (@filter_dir) {
	return 0 unless grep $perl->{dir} eq $_, @filter_dir;
    }
    return 1;
}

sub cmd_list_results {
    my @hosts = @_;
    my @perls = grep _filter_perl($_), $res->perls(@hosts);
    unless (@perls) {
	print "No results to report!\n";
	return;
    }

    if ($merge) {
	for my $p (@perls) {
	    my @t = @{$p->{t}};
	    my %t;
	    for (@t) {
		push(@{$t{$_->{test}}}, $_);
	    }
	    @t = ();
	    for (values %t) {
		if (@$_ > 1) {
		    my %res = %{$_->[0]};
		    for my $f (qw(min med max avg)) {
			$res{$f} = calc_stats([map $_->{$f}, @$_])->{$f};
		    }
		    delete $res{loop_overhead};
		    delete $res{std_dev};  # XXX can it be merged?
		    push(@t, \%res);
		}
		else {
		    die unless @$_;
		    push(@t, $_->[0]);
		}
	    }
	    $p->{t} = \@t;
	}
    }

    my %minmed;
    my %minmed_min;
    for my $p (@perls) {
	for my $t (@{$p->{t}}) {
	    my $name = $t->{test};
	    if (!defined($minmed{$name}) || $minmed{$name} > $t->{med}) {
		$minmed{$name} = $t->{med};
		$minmed_min{$name} = $t->{min};
	    }
	}
    }

    for my $p (@perls) {
	print "$p->{name}\n";
	print "    \@$p->{host}\n" unless @hosts == 1;
        print "    # resdir = $p->{dir}\n" if $show_dir;
        print "    # path = $p->{path}\n" if $show_path;
    CONFIG:
	for my $ck (sort keys %{$p->{config} || {}}) {
	    my $v = $p->{config}{$ck};
	    for my $p2 (@perls) {
		if ($v ne $p2->{config}{$ck}) {
		    $v = remove_common_words($v, map $_->{config}{$ck}, @perls)
			if $ck eq "ccflags" || $ck eq "optimize";
		    print "    # $ck = $v\n";
		    next CONFIG;
		}
	    }
	}
	for my $t (sort {$b->{med} <=> $a->{med}} @{$p->{t}}) {
	    my($name) = split(' ', $t->{test});
	    $name =~ s,^benchmarks/,,;
	    $name =~ s,\.b$,,;

	    printf "    %-35s %-18s ", $name,
		sec_f($t->{med}, $t->{med} - $t->{min});

	    my $minmed = $minmed{$t->{test}};
	    my $minmed_min = $minmed_min{$t->{test}};
	    if ($minmed == $t->{med} && $minmed_min == $t->{min}) {
		print "-";
	    }
	    else {
		my $minmed_max = $minmed + ($minmed - $minmed_min);

		my $p_max = ($t->{med} + ($t->{med} - $t->{min}) - $minmed_min) / $minmed_min;
		my $p_min = ($t->{min} - $minmed_max) / $minmed_max;
		my $p_avg = ($p_max + $p_min) / 2;

		print num_f($p_avg * 100, ($p_avg - $p_min) * 100, "%");
	    }
	    print "\n";
	}
    }
}

sub remove_common_words {
    my $w = $_[0];
    my %w;
    for (@_) {
	my %w2;
	for (split(' ')) {
	    $w2{$_}++;
	}
	for (keys %w2) {
	    $w{$_}++;
	}
    }
    return join(" ", grep $w{$_} != @_, split(' ', $w));
}

sub usage {
    (my $progname = $0) =~ s,.*/,,;
    die "Usage: $progname [options] <cmd> [cmd-options]\n";
}
