#!/usr/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil -*- # # The contents of this file are subject to the Mozilla Public License # Version 1.1 (the "License"); you may not use this file except in # compliance with the License. You may obtain a copy of the License at # http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the # License for the specific language governing rights and limitations # under the License. # # The Original Code is the Mozilla graph tool. # # The Initial Developer of the Original Code is Apple Computer, Inc. # # Portions created by Apple Computer, Inc. are Copyright (C) 2005 Apple Computer, Inc. # All Rights Reserved. # # Contributor(s): # Apple Computer, Inc. # Chris McAfee , # # # # CGI to interactively build up a machine/test matrix to compare performance graphs. # URLs can be saved off to static pages, and you can also alter queries easily # to compare a machine with another machine not in the default query, likewise for tests. # # To-do: convert this to use the standard CGI package, the one you # get from CPAN. # use strict; use CGI::Carp qw(fatalsToBrowser); # CPAN use CGI::Request; # http://stein.cshl.org/WWW/software/CGI::modules/ my $req = new CGI::Request; my $TBOXES = lc($req->param('tboxes')); chomp($TBOXES); my $TESTS = $req->param('tests'); chomp($TESTS); my %englishTestnames = (); # English for testnames. my %machineConfigs = (); # Machine configs. # Pick a default 2 machines, our main performance machine. unless($TBOXES) { # hmm not sure we want a default here, start with nothing? #$TBOXES = "machine1, machine2"; } else { # Convert spaces to , list. This will let the user type in # space-delimited list in the text field. $TBOXES =~ s/\ /,/g; # Reduce multiple , to one , $TBOXES =~ s/,+/,/g; } # Pick a default test. unless($TESTS) { # hmm don't do this right now. #$TESTS = "sample_test_name"; } else { # Strip \n, change to space, we clean up spaces below. $TESTS =~ s/\xd/\ /g; # Last character should not be " ". $TESTS =~ s/\ $//g; # Strip LF $TESTS =~ s/\xa//g; # Convert spaces to , list. This will let the user type in # space-delimited list in the text field. $TESTS =~ s/\ /,/g; # Reduce multiple ,, to one , $TESTS =~ s/,+/,/g; } sub getMachineOptionValues { # assume we just want a list of machines from the first test, # the plasma test. if you don't do this test, you lose. # # To-do: Fix this dependency. The way the data in the db directory is # db/testnames/machine-names # We could walk this directory to get a list of machines instead. # Or, at data-collection time, start maintaining a list of machine names. # # Get plasma machines. my @rawFiles; my @files; print "\n"; opendir(DIRNAME, "db/a-common-test-here") || die "can't open directory $!"; @rawFiles = map("$_", sort grep !/^\.\.?$/, readdir DIRNAME); closedir(DIRNAME); # Yank _avg from @files foreach(@rawFiles) { unless(/_avg$/) { push(@files, $_); } } # Add option entries for each plasma machine. foreach(@files) { print "\n"; } } # Provide an English-to-testname mapping if the testnames # are too long, or you want to clean the name up. sub loadEnglishTestnames { $englishTestnames{"testname01_as_cgi_submitted"} = "Nicer test01 name"; } # Store up some machine configs. These are displayed as # mouse-overs on the machine column header. sub loadMachineConfigs { $machineConfigs{"localhost.foo.bar"} = "2x1.8GHz G5, 1GB"; } # Lookup English name, fall back to submitted name. sub getEnglishTestname { my ($testname) = @_; my $englishTestname = $englishTestnames{$testname}; # If we don't have a better name, fallback to basic version. if($englishTestname eq "") { $englishTestname = $testname; # Try to reduce horizontal space here. $englishTestname =~ s/\./\.\/g; } return $englishTestname; } # Lookup machine config, do nothing if not found. # This is used for mouse-over title tags on the machine column. sub getMachineConfig { my ($machineName) = @_; my $machineConfig = $machineConfigs{$machineName}; my $rv = ""; # If we don't have a hit, return nothing. unless($machineConfig eq "") { $rv = "title=\"$machineConfig\""; } return $rv; } # Get a list of tests. sub getTestOptionValues { my @rawFiles; my @files; print "\n"; opendir(DIRNAME, "db") || die "can't open directory $!"; @rawFiles = map("$_", sort grep !/^\.\.?$/, readdir DIRNAME); closedir(DIRNAME); foreach(@rawFiles) { unless(/_avg$/) { push(@files, $_); } } # Add option entries for each test. foreach(@files) { print "\n"; } } # Title, machine names form. First row of table. sub printLeader { print "Content-type: text/html\n\n\n"; print "\n"; print "Compare graphs for $TBOXES
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "
Compare Graphs           \n"; print "           = good if data moves up,  = good if data moves down
\n"; print "
\n"; print "\n"; print "\n"; # # First row, machines # print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; # Dummy row. print "\n"; # # 2nd row, tests. # print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
machines:\n"; print "\n"; #print ""; print "
\n"; print "\n"; print "
  
tests:\n"; print "\n"; #print ""; print "
\n"; print "\n"; print "
\n"; print "\n"; print "
\n"; print "
\n"; # Start the graphs table. print "\n"; print "\n"; } sub createGraphLink { my ($testname, $machineName) = @_; my $link = ""; return $link; } # Fill out table, for each test, show graph for each machine in order. sub printGraphs { my @machines = split(",", $TBOXES); my @tests = split(",", $TESTS); # TOC row print "\n"; print "\n"; # TOC content foreach(@machines) { my $machine = $_; $machine =~ s/_.*$//g; my $config = getMachineConfig($machine); if($config eq "") { print "\n"; } else { print "\n"; } } print "\n"; # loop over tests. foreach(@tests) { my $test = $_; # # For each test, print out the machine row. # print "\n"; # First print the LHS column. print "\n"; # Now the machines. foreach(@machines) { my $machine = $_; print "\n"; } print "\n"; } } # Finish. sub printTrailer { # End the table. print "
Test name$_$_
\n"; print getEnglishTestname($test); print "\n"; print createGraphLink($test, $machine); print "
\n"; } # main { loadEnglishTestnames(); loadMachineConfigs(); printLeader(); printGraphs(); print "\n"; }