/usr/local/CPAN/perlbench/PerlBench/Results.pm

• package PerlBench::Results
  • new
  • _scan
  • _read_pb_file
  • hosts
  • perls
  • _vers_cmp
• EOF

package PerlBench::Results;

use strict;
use File::Find ();

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);
	    }

	    $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}) } @p;
    return @p;
}

sub _vers_cmp {
    my($v1, $v2) = @_;
    return $v1 cmp $v2;
}

1;