package PerlBench::Results;
use strict;
use File::Find ();
our $VERSION = "1.001";
my %SIGNIFICANT_CONFIG_KEYS = map { $_ => 1 } qw(
    cc ccversion gccversion
    optimize ccflags
    usethreads usemultiplicity
    uselargefiles
    use64bitint use64bitall uselongdouble
    usemymalloc useshrplib
    osvers
);
sub new {
    my $class = shift;
    my $resdir = shift || "perlbench-results";
    return undef unless -d $resdir;
    my $self = bless {}, $class;
    $self->_scan($resdir);
    return $self;
}
sub _scan {
    my($self, $dir) = @_;
    $self->{dir} = $dir;
    # locate result files
    my @res;
    File::Find::find(sub {
       if (/\.pb$/) {
           my $f = $File::Find::name;
           $f = substr($f, length($dir) + 1);
           $f =~ s,\\,/,g if $^O eq "MSWin32";
           push(@res, $f);
       }
    }, $dir);
    # read results
    for my $f (@res) {
        #print "$f\n";
        my($hostname, $perls, $perl, $tests) = split("/", $f);
        die unless $perls eq "perls";
        die unless $tests eq "tests";
        my $res = _read_pb_file("$dir/$f");
        push(@{$self->{h}{$hostname}{p}{$perl}{t}}, $res);
    }
    # fill in additional information about hosts and perls
    while(my($hostname, $hosthash) = each %{$self->{h} || {}}) {
        #print "host $hostname\n";
        while (my($perl, $perlhash) = each %{$hosthash->{p}}) {
            #print " perl $perl\n";
            my $perldir = "$dir/$hostname/perls/$perl";
            my $version_txt = "$perldir/version.txt";
            open(my $fh, "<", $version_txt) || die "Can't open $version_txt: $!";
            local($_);
            while (<$fh>) {
                if (/^This is perl, v(\S+)/) {
                    $perlhash->{version} = $1;
                    $perlhash->{name} = "perl-$1";
                }
                if (/^Binary build (\d+.*) provided by ActiveState/) {
                    $perlhash->{name} .= " build $1";
                    $perlhash->{name} =~ s/^perl/ActivePerl/;
                }
            }
            die "Can't determine perl version from $version_txt" unless $perlhash->{version};
            close($fh);
            if (open(my $fh, "<", "$perldir/config-summary.txt")) {
                while (<$fh>) {
                    if (/^Summary of/ && / patch\s+(\d+)/) {
                        $perlhash->{version} .= "-p$1";
                        $perlhash->{name} .= " patch $1";
                    }
                    elsif (/\bDEBUGGING\b/) {
                        $perlhash->{name} .= " (DEBUGGING)";
                    }
                }
                close($fh);
            }
            if (open(my $fh, "<", "$perldir/config.sh")) {
                while (<$fh>) {
                    if (/^(\w+)='([^']*)'$/) {
                        my($k, $v) = ($1, $2);
                        $perlhash->{config}{$1} = $2 if $SIGNIFICANT_CONFIG_KEYS{$1};
                    }
                    else {
                        chomp;
                        warn "Can't parse [$_]";
                    }
                }
            }
            if (open(my $fh, "<", "$perldir/path.txt")) {
                if (defined(my $path = <$fh>)) {
                    chomp($path);
                    $perlhash->{path} = $path;
                }
            }
            $perlhash->{dir} = $perldir;
            $perlhash->{host} = $hostname;
        }
    }
}
sub _read_pb_file {
    my $file = shift;
    open(my $fh, "<", $file) || die "Can't open '$file': $!";
    my %hash;
    local($_);
    while (<$fh>) {
        if (/^(\w[\w-]*)\s*:\s*(.*)/) {
            my($k, $v) = ($1, $2);
            $k = lc($k);
            $k =~ s/-/_/g;
            $hash{$k} = $v;
        }
        else {
            warn "$file: $_";
        }
    }
    close($fh);
    #$hash{file} = $file;
    return \%hash;
}
sub hosts {
    my $self = shift;
    die unless wantarray;
    return sort keys %{$self->{h} || {}};
}
sub perls {
    my($self, @hosts) = @_;
    die unless wantarray;
    @hosts = $self->hosts unless @hosts;
    my @p;
    for my $h (@hosts) {
        push(@p, values %{$self->{h}{$h}{p}});
    }
    @p = sort { _vers_cmp($a->{version}, $b->{version}) || ($a->{config}{osvers} cmp $b->{config}{osvers}) } @p;
    return @p;
}
sub _vers_cmp {
    my($v1, $v2) = @_;
    return $v1 cmp $v2;
}
1;