#!/usr/bin/perl -w

use strict;

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

use PerlBench qw(timeit);
use Sys::Hostname qw(hostname);
use Digest::MD5 qw(md5_hex);
use File::Path qw(mkpath);
use Getopt::Long qw(GetOptions);
use File::Spec::Functions qw(file_name_is_absolute);

my $resdir = "perlbench-results";
my $hostname = hostname();
my $perl = $^X;
my $VERBOSE = 0;

my %opt;
GetOptions(
   'verbose+' => \$VERBOSE,
) || usage();

my @tests = @ARGV ? (@ARGV) : do {
    die "Can't find any benchmarks directory" unless -d "benchmarks";
    use File::Find;
    my @f;
    File::Find::find(sub { /\.b$/ && push(@f, $File::Find::name) }, "benchmarks");
    sort @f;
};
die unless @tests;

$| = 1;

die "Need absolute perl name" unless file_name_is_absolute($perl);

print "Host: $hostname\n";
my $hostdir = "$resdir/$hostname";
if (-d $hostdir) {
    # check that this host look similar
}
else {
    mkpath($hostdir, 0, 0755) || die "Can't create $hostdir: $!";
    file("$hostdir/osname.txt", "$^O\n");
    file("$hostdir/osversion.txt", get_os_version()."\n");
    system("uname -a >$hostdir/uname-a.txt") if $^O ne "MSWin32";
    system("uname -X >$hostdir/uname-X.txt") if $^O eq "solaris";
    system("cp /proc/cpuinfo $hostdir/cpuinfo.txt") if -f "/proc/cpuinfo";
}

print "Perl: $perl\n";
my $perl_V = qx($perl -V);

my $perldir = "$hostdir/perls/" . md5_hex("$perl\0$perl_V");
if (-d $perldir) {
    # check that this perl looks similar
    die "perl -V output doesn't match"
	unless file("$perldir/config-summary.txt") eq $perl_V;
}
else {
    mkpath("$perldir/tests", 0, 0755);
    file("$perldir/path.txt", $perl);
    system(qq($perl -v >$perldir/version.txt));
    file("$perldir/config-summary.txt", $perl_V);
    system(qq($perl -MConfig=config_sh -e "print &config_sh()" >$perldir/config.sh));
}

for my $test (@tests) {
    print "Test-File: $test\n";
    run_test($test);
}


sub run_test {
    my $test = shift;
    open(my $fh, "<", $test) || die "Can't open $test: $!";
    my $header = 1;
    my %prop;
    my @init;
    my @code;
    while (<$fh>) {
	if ($header) {
	    if (/^\#\s*(\w+)\s*:\s*(.*)/) {
		$prop{lc($1)} = $2;
	    }
	    else {
		$header = 0;
	    }
	}
	else {
	    if (/^\#\#\#\s*TEST\s*$/) {
		die if @init;
		@init = @code;
		@code = ();
	    }
	    else {
		push(@code, $_);
	    }
	}
    }
    close($fh);

    print "Test-Name: $prop{name}\n" if $prop{name};

    trim(\@init);
    trim(\@code);

    my %opt;
    $opt{verbose} = 1 if $VERBOSE;
    $opt{init} = join("", @init) if @init;
    $opt{repeat} = $prop{repeat} if $prop{repeat};
    $opt{enough} = $prop{enough} if $prop{enough};

    my $start = time2iso();
    my $res = timeit(join("", @code), %opt);

    my $resfile = $start;
    $resfile =~ s/ /T/;  # spaceless iso format
    $resfile =~ s/[-:]//g;  # compact and windows compatible
    $resfile = "$perldir/tests/$resfile.pb";
    open($fh, ">", $resfile) || die "Can't create $resfile: $!";
    my $end = substr(time2iso(), 11);

    # system info
    print $fh "Date: $start ($end)\n";
    print $fh "PerlBench-Version: $PerlBench::VERSION\n";
    print $fh "Test: $test md5:", md5_hex(file($test)), "\n";
    print $fh "Perl: $perl $]\n";
    print $fh "Hostname: $hostname\n";
    if (-x "/usr/bin/uptime") {
	my($up) = qx(/usr/bin/uptime);
	chomp($up);
	$up =~ s/\s+/ /g;
	$up =~ s/^\s+//;
	print $fh "System-Uptime: $up\n";
    }

    # test results
    print $fh "Cycles: $res->{count}\n";
    printf $fh "Loop-Overhead: %.1f%%\n", 100*$res->{loop_overhead_relative};
    print $fh "Samples: $res->{n}\n";
    print $fh "Min: $res->{min}\n";
    print $fh "Med: $res->{med}\n";
    print $fh "Max: $res->{max}\n";
    print $fh "Avg: $res->{avg}\n";
    print $fh "Std-Dev: $res->{stddev}\n";

    close($fh) || die "Can't write $resfile: $!";
    print "Test-Result: $resfile\n";
}

sub time2iso
{
    my $time = shift;
    $time = time unless defined $time;
    my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
            $year+1900, $mon+1, $mday, $hour, $min, $sec);
}

sub trim {
    my $lines = shift;
    shift(@$lines) while @$lines && $lines->[0] =~ /^$/;
    pop(@$lines) while @$lines && $lines->[-1] =~ /^$/;
}

sub file {
    my $name = shift;
    if (@_) {
        my $content = shift;
        open(my $f, ">", $name) || die "Can't create '$name': $!";
        binmode($f);
        print $f $content;
        close($f) || die "Can't write to '$name': $!";
    }
    else {
        open(my $f, "<", $name) || return undef;
        binmode($f);
        local $/;
        return scalar <$f>;
    }
}

sub get_os_version {
    if ($^O eq "MSWin32") {
	my($string, $major, $minor, $build, $id, $spmajor, $spminor, $suitemask, $producttype) = Win32::GetOSVersion();
	if ($id == 0) {
	    $major = 0;
	    $minor = 0;
	}
	my $ver = "Windows $major.$minor";
	$ver .= ".$build" if $build;
	if ($id >= 2 && $major >= 4) {
	    if ($spmajor || $spminor) {
		$ver .= " SP$spmajor.$spminor";
	    }
	}
	my $name = {
	    "0.0.0" => "Win32s",
            "1.4.0" => "Windows 95",
	    "1.4.10" => "Windows 98",
            "1.4.90" => "Windows Me",
            "2.3.51" => "Windows NT 3.51",
	    "2.4.0" => "Windows NT 4",
	    "2.5.0" => "Windows 2000",
            "2.5.1" => "Windows XP",
            "2.5.2" => "Windows Server 2003",
            "2.6.0" => "Windows Vista",
        }->{"$id.$major.$minor"} || "Windows";
	$ver .= " ($name $string)";
	return $ver;
    }

    my($ver) = qx(uname -sr);
    chomp($ver);
    return $ver;
}