mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-11-06 00:55:37 +00:00
1059 lines
36 KiB
Perl
1059 lines
36 KiB
Perl
# The contents of this file are subject to the Netscape 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/NPL/
|
|
#
|
|
# 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 Netscape Mailstone utility,
|
|
# released March 17, 2000.
|
|
#
|
|
# The Initial Developer of the Original Code is Netscape
|
|
# Communications Corporation. Portions created by Netscape are
|
|
# Copyright (C) 1997-2000 Netscape Communications Corporation. All
|
|
# Rights Reserved.
|
|
#
|
|
# Contributor(s): Dan Christian <robodan@netscape.com>
|
|
# Marcel DePaolis <marcel@netcape.com>
|
|
#
|
|
# Alternatively, the contents of this file may be used under the
|
|
# terms of the GNU Public License (the "GPL"), in which case the
|
|
# provisions of the GPL are applicable instead of those above.
|
|
# If you wish to allow use of your version of this file only
|
|
# under the terms of the GPL and not to allow others to use your
|
|
# version of this file under the NPL, indicate your decision by
|
|
# deleting the provisions above and replace them with the notice
|
|
# and other provisions required by the GPL. If you do not delete
|
|
# the provisions above, a recipient may use your version of this
|
|
# file under either the NPL or the GPL.
|
|
#####################################################
|
|
|
|
# for each protocol, store rate over time (figure derivative), and final count
|
|
# commands
|
|
# readMessages
|
|
# writeMessages
|
|
# readBytes
|
|
# writeBytes
|
|
# connections
|
|
# these are already 0 based over time, and average
|
|
# connectDelay
|
|
# transactionTime
|
|
|
|
#require "perl-5.005";
|
|
|
|
#use Cwd;
|
|
|
|
print "Combining client results:\t", scalar (localtime), "\n";
|
|
|
|
# Basic sanity check
|
|
unless ($testsecs > 0) {
|
|
die "Test time is 0!\n";
|
|
}
|
|
|
|
$startTime = 0; # these are timeInSeconds/$timeStep
|
|
$endTime = 0;
|
|
|
|
# keep graphs with somewhat more precision than sample rate
|
|
# this is supposed to help deal with time skew between clients
|
|
#$timeStep = int ($params{FREQUENCY} / 2);
|
|
#if ($timeStep < 1) { $timeStep = 1; }
|
|
$timeStep = int ($params{FREQUENCY});
|
|
|
|
# global results initialization
|
|
$reportingClients = 0;
|
|
$totalProcs = 0; # number of clients started
|
|
|
|
my $maxTimeStep = $params{FREQUENCY}*2;
|
|
$maxTimeStep = 10 if ($maxTimeStep < 10);
|
|
|
|
|
|
# Fill in graph values
|
|
# Usage: updateGraph (graph, lastTimeStep, TimeStep, timeSecs,
|
|
# lastValue, value);
|
|
sub updateGraph {
|
|
#SLOW: my ($gp, $lastTime, $time, $timeD, $lastValue, $value) = @_;
|
|
my $gp = shift; # gp: graph hash to fill in over time
|
|
my $lastTime = shift; # lastTime: time values (already divided by timestep)
|
|
my $time = shift;
|
|
my $timeD = shift; # timeD: time delta in seconds
|
|
my $lastValue = shift;
|
|
my $value = shift;
|
|
return unless ($timeD); # initial case
|
|
|
|
#print "updateGraph: time='$time' timeD='$timeD' lastValue='$lastValue' value='$value'\n";
|
|
my $v = ($value - $lastValue) / $timeD; # figure update / step
|
|
for ($i = $lastTime; $i < $time; $i++) { # fill in graph
|
|
$gp->{$i} += $v;
|
|
}
|
|
}
|
|
|
|
# Fill in graph values, figuring the MIN
|
|
# Usage: updateMinGraph (graph, lastTimeStep, TimeStep, value);
|
|
sub updateMinGraph {
|
|
my $gp = shift; # graph hash to fill in over time
|
|
my $lastTime = shift; # time values (already divided by timestep)
|
|
my $time = shift;
|
|
my $v = shift;
|
|
return unless ($lastTime); # initial case
|
|
return unless ($v > 0); # 0 min is considered no information
|
|
|
|
#print "updateMinGraph: time='$time' lastTime='$lastTime' value='$v'\n";
|
|
for ($i = $lastTime; $i < $time; $i++) { # fill in graph
|
|
$gp->{$i} = $v if (!($gp->{$i}));
|
|
$gp->{$i} = $v if ($v < $gp->{$i});
|
|
}
|
|
}
|
|
|
|
# Fill in graph values, figuring the MAX
|
|
# Usage: updateMaxGraph (graph, lastTimeStep, TimeStep, value);
|
|
sub updateMaxGraph {
|
|
my $gp = shift; # graph hash to fill in over time
|
|
my $lastTime = shift; # time values (already divided by timestep)
|
|
my $time = shift;
|
|
my $v = shift;
|
|
return unless ($lastTime); # initial case
|
|
|
|
#print "updateMaxGraph: time='$time' lastTime='$lastTime' value='$v'\n";
|
|
for ($i = $lastTime; $i < $time; $i++) { # fill in graph
|
|
$gp->{$i} = $v if (!($gp->{$i}));
|
|
$gp->{$i} = $v if ($v > $gp->{$i});
|
|
}
|
|
}
|
|
|
|
# Turn one of the disadvantages of interpreted code to an advantage
|
|
# by writing optimal code on the fly.
|
|
# You must be taller than Kenny the kangaroo to edit this code.
|
|
# Create a function that will parse timers (all timer must be identical)
|
|
# Timer are built out of positional assignments (not attr=value pairs)
|
|
sub CreateFastTimerParser {
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string
|
|
|
|
my @tlist = @{$ltype->{"$fstr:SEPS"}};
|
|
my @nlist = @{$ltype->{"$fstr:NAMES"}};
|
|
|
|
# function preamble
|
|
my $fn = "sub FastTimerParser {\n";
|
|
|
|
$fn .= 'my $sc = shift; my $gp = shift;
|
|
my $lt = shift; my $t = shift; my $td = shift;
|
|
my $ltype = shift; my $fstr = shift;
|
|
my $ln = shift;' . "\n";
|
|
|
|
#$fn .= 'print "(fastTimerParser) $fstr $lt $t $td\n";' . "\n";
|
|
$fn .= 'if ($ln =~ m/^';
|
|
|
|
foreach $s (@tlist) { # write pattern match
|
|
$fn .= "(.+)$s";
|
|
}
|
|
$fn .= '(.+)$/) {' . "\n"; # last field in match
|
|
#$fn .= 'print "$ln =\t$1 + $2 / $3 + $4 / $5 [ $6 , $7 ] $8\n";' . "\n";
|
|
|
|
my $n = 0;
|
|
foreach $v (@nlist) { # write update calls
|
|
$n++;
|
|
if ($v =~ /Min$/) {
|
|
$fn .= 'updateMinGraph ($gp->{"' . $v . '"}, $lt, $t, $' . $n . ");\n";
|
|
# Handle never defined case first.
|
|
$fn .= '$sc->{"' . $v . '"} = 0 if (!($sc->{"' . $v . '"}));' . "\n";
|
|
# Do the Min update. 0 is not a valid number
|
|
$fn .= '$sc->{"' . $v . '"} = $' . $n . ' if (($' . $n . ' > 0) && (($sc->{"' . $v . '"} == 0) || ($' . $n . ' < $sc->{"' . $v . '"})));' . "\n";
|
|
} elsif ($v =~ /Max$/) {
|
|
$fn .= 'updateMaxGraph ($gp->{"' . $v . '"}, $lt, $t, $' . $n . ");\n";
|
|
$fn .= '$sc->{"' . $v . '"} = $' . $n . ' if (!($sc->{"' . $v . '"}) || ($' . $n . ' > $sc->{"' . $v . '"}));' . "\n";
|
|
} else {
|
|
$fn .= 'updateGraph ($gp->{"' . $v . '"}, $lt, $t, $td, $sc->{"' . $v . '"}, $' . $n . ");\n";
|
|
$fn .= '$sc->{"' . $v . '"} = $' . $n . ";\n";
|
|
}
|
|
}
|
|
$fn .= "\n} else {\n";
|
|
$fn .= 'die "Error parsing timer from: $ln\n";';
|
|
$fn .= "\n}\n}\n";
|
|
#($params{DEBUG}) && print "Created timer parse function: $fn\n";
|
|
eval $fn; # create the function
|
|
$timerParser = \&FastTimerParser;
|
|
}
|
|
# All this quoted stuff will screw up Emacs' formatter/colorizer. Oh well.
|
|
|
|
# Similar to above.
|
|
# This seems to be a smaller gain (about 10%) than the timers.
|
|
sub CreateFastProtocolParser {
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string
|
|
|
|
my @tlist = @{$ltype->{"$fstr:SEPS"}};
|
|
my @nlist = @{$lst = $ltype->{"$fstr:NAMES"}};
|
|
|
|
#print "CreateFastProtocolParser: $fstr\n";
|
|
|
|
my $nm = $fstr;
|
|
$nm =~ s/^.*://;
|
|
my $fn = "sub FastProtocolParser$nm {\n";
|
|
$fn .= 'my $sc = shift; my $gp = shift;
|
|
my $lt = shift; my $t = shift; my $td = shift;
|
|
my $ltype = shift; my $fstr = shift;
|
|
my $ln = shift;' . "\n";
|
|
|
|
#$fn .= 'print "(FastProtocolParser' . $nm . ' ) $fstr $lt $t $td\n";' . "\n";
|
|
$fn .= 'if ($ln =~ m/^';
|
|
my $posttext = pop @tlist; # save last bit of text
|
|
foreach $s (@tlist) { # write pattern match
|
|
$fn .= "$s(.+)";
|
|
}
|
|
$fn .= $posttext . '$/) {' . "\n"; # last text in match
|
|
my $n = 0;
|
|
foreach $v (@nlist) { # write update calls
|
|
$n++;
|
|
if ($v =~ m/^\[(.+)\]$/) { # timer
|
|
$fn .= 'FastTimerParser ($sc->{"' . $1 . '"}, $gp->{"' . $1 . '"}, $lt, $t, $td, $ltype, "TIMERS:' . $1 . '", $' . $n . ');' . "\n";
|
|
} else { # direct assignment
|
|
$fn .= 'updateGraph ($gp->{"' . $v . '"}, $lt, $t, $td, $sc->{"' . $v . '"}, $' . $n . ');' . "\n";
|
|
$fn .= '$sc->{"' . $v . '"} = $' . $n . ";\n";
|
|
}
|
|
}
|
|
$fn .= "\n} else {\n";
|
|
$fn .= 'die "Error parsing protocol ' . $nm . ' from: $ln\n";';
|
|
$fn .= "\n}\n}\n";
|
|
$fn .= '$cliLines{"SUMMARY-TIME"}->{"' . $fstr . ':PROTOPARSE"} = \&FastProtocolParser' . $nm . ";\n";
|
|
#print "Created proto parse function: $fn\n";
|
|
eval $fn; # create the function
|
|
}
|
|
|
|
# This is the slow verson of timer parsing. Kept for possible debugging
|
|
# There are only 4 levels to the parse hierarchy: line, protocol, timer, value
|
|
# each level consists of 1 or more elements from lower levels, plus text
|
|
|
|
# Given a timer format description, break string into name,value chunks
|
|
# Timer are built out of positional assignments (not attr=value pairs)
|
|
# Usage: parseTimer (...lineHash, format, line)
|
|
sub parseTimer {
|
|
my $subcli = shift; # client hash to update
|
|
my $gp = shift; # graph hash to fill in over time
|
|
my $lastTime = shift; # time values (already divided by timestep)
|
|
my $time = shift;
|
|
my $timeD = shift;
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string
|
|
my $line = shift # text line
|
|
|| die "Missing arguments to parseTimer";
|
|
|
|
my @tlist = @{$ltype->{"$fstr:SEPS"}};
|
|
my @nlist = @{$lst = $ltype->{"$fstr:NAMES"}};
|
|
#print "\nTimer seps ($fstr): @tlist\nNames: @nlist\n";
|
|
|
|
my $remln = $line;
|
|
|
|
while (@nlist) {
|
|
my $chunk;
|
|
my $sepln;
|
|
my $posttext = shift @tlist;
|
|
my $vname = shift @nlist;
|
|
|
|
if ($posttext) { # remln looks like <value><literal text>...
|
|
($chunk, ($sepln), $remln) = split /($posttext)/, $remln, 2;
|
|
#print "chunk='$chunk' sep='$sepln' remln='$remln'\n";
|
|
die "Error finding string '$posttext' in '$remln' of '$line'"
|
|
unless ($sepln);
|
|
} else { # remln looks like <value>
|
|
$chunk = $remln;
|
|
}
|
|
#print "$vname=$chunk ";
|
|
die "updateGraph: Missing graph '$vname'\n" unless ($gp->{$vname});
|
|
if ($vname =~ /Min$/) {
|
|
updateMinGraph ($gp->{$vname}, $lastTime, $time, $chunk);
|
|
} elsif ($vname =~ /Max$/) {
|
|
updateMaxGraph ($gp->{$vname}, $lastTime, $time, $chunk);
|
|
} else {
|
|
updateGraph ($gp->{$vname}, $lastTime, $time, $timeD,
|
|
$subcli->{$vname}, $chunk);
|
|
}
|
|
$subcli->{$vname} = $chunk;
|
|
}
|
|
#print "\n";
|
|
}
|
|
|
|
# This is the slow verson of protocol parsing. Kept for possible debugging
|
|
# Given a format description, break string into name,value chunks
|
|
# Very similar to parseLine, except: no sub protocols, no top level issues
|
|
# Usage: parseProtocol (...lineHash, format, line)
|
|
sub parseProtocol {
|
|
my $subcli = shift; # client hash to update
|
|
my $gp = shift; # graph hash to fill in over time
|
|
my $lastTime = shift; # time values (already divided by timestep)
|
|
my $time = shift;
|
|
my $timeD = shift;
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string
|
|
my $line = shift # text line
|
|
|| die "Missing arguments to parseProtocol";
|
|
|
|
#print "\nparseProtocol format='$fstr' line='$line'\n";
|
|
|
|
my @tlist = @{$ltype->{"$fstr:SEPS"}};
|
|
my @nlist = @{$lst = $ltype->{"$fstr:NAMES"}};
|
|
#print "\nProtocol seps ($fstr): @tlist\nNames: @nlist\n";
|
|
|
|
# remove first part of literal text
|
|
my $posttext = shift @tlist;
|
|
my ($chunk, $sepln, $remln) = split /($posttext)/, $line, 2;
|
|
die "Error parsing initial string '$posttext' from '$line'"
|
|
unless ($sepln);
|
|
|
|
# progressively split $fstr into literal chunks
|
|
# back to back timers or protocols (with no literal space) is not allowed
|
|
while (@nlist) {
|
|
# remln always looks like <value><literal text>
|
|
my $vname = shift @nlist;
|
|
$posttext = shift @tlist;
|
|
#print "posttext='$posttext'\n";
|
|
|
|
($chunk, ($sepln), $remln) = split /($posttext)/, $remln, 2;
|
|
#print "chunk='$chunk'\n";
|
|
#print "remln=$remln\n\n";
|
|
die "Error finding string '$posttext' in '$remln'"
|
|
unless ($sepln);
|
|
|
|
if ($vname =~ m/^\[(.+)\]$/) { # timer
|
|
#print "TIMER $vname ";
|
|
die "Unknown timer referenced: $vname for client "
|
|
. $scalar{"client"} . "\n"
|
|
unless ($subcli->{$1});
|
|
die "Invalid timer specified: $ltype->{TIMERS}->{$vname} in '$line'"
|
|
unless ($ltype->{TIMERS}->{$vname});
|
|
FastTimerParser ($subcli->{$1}, $gp->{$1},
|
|
$lastTime, $time, $timeD,
|
|
$ltype, "TIMERS:$1", $chunk);
|
|
} else { # direct assignment
|
|
#print "$vname='$chunk' ";
|
|
die "updateGraph: Missing graph '$vname'\n" unless ($gp->{$vname});
|
|
updateGraph ($gp->{$vname}, $lastTime, $time, $timeD,
|
|
$subcli->{$vname}, $chunk);
|
|
$subcli->{$vname} = $chunk;
|
|
}
|
|
}
|
|
#print "\n";
|
|
}
|
|
|
|
# Given a format description, break string into name,value chunks
|
|
# Figures out all the top level issues of:
|
|
# Figure out what client, what time span,
|
|
# Pass down top level structures
|
|
# Do final special processing (connections graph)
|
|
# Usage: parseLine (clientsHash, lineHash, format, line)
|
|
sub parseLine {
|
|
my $clients = shift; # hash of all clients
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string to match
|
|
my $line = shift # line to parse up
|
|
|| die "Missing arguments to parseLine";
|
|
#print "parseLine: $line\n"; # format='$fstr'
|
|
|
|
my %scalar = (); # hold scalars until client storage located
|
|
my $subcli; # client hash to update ($clients->{$n})
|
|
my $lastTime; # time values (already divided by timestep)
|
|
my $time;
|
|
my $timeD; # time delta (in seconds)
|
|
|
|
my @tlist = @{$ltype->{"$fstr:SEPS"}};
|
|
my @nlist = @{$lst = $ltype->{"$fstr:NAMES"}};
|
|
#print "\nLine seps ($fstr): @tlist\nNames: @nlist\n";
|
|
|
|
# remove first part of literal text
|
|
# This should always work, since we pattern matched on this to get here
|
|
my $posttext = shift @tlist;
|
|
my $vname;
|
|
#print "posttext='$posttext'";
|
|
my ($chunk, $sepln, $remln) = split /($posttext)/, $line, 2;
|
|
die "Error parsing initial string '$posttext' from '$line'"
|
|
unless ($sepln);
|
|
|
|
# progressively split $fstr into literal chunks
|
|
while (@nlist) {
|
|
# remln always looks like <value><literal text>
|
|
$vname = shift @nlist;
|
|
$posttext = shift @tlist;
|
|
#print "\nposttext='$posttext' vname='$vname'\n";
|
|
|
|
($chunk, ($sepln), $remln) = split /($posttext)/, $remln, 2;
|
|
#print "chunk='$chunk'\n";
|
|
#print "remln=$remln\n\n";
|
|
die "Error finding string '$posttext' in '$remln'"
|
|
unless ($sepln);
|
|
|
|
if (($vname =~ m/^\[.+\]$/)
|
|
|| ($vname =~ m/^\{.+\}$/)){ # timer or hash
|
|
|
|
unless ($subcli) { # setup sub client
|
|
$subcli = $clients->{$scalar{"client"}};
|
|
die "Error parsing client number $scalar{client}"
|
|
unless ($subcli);
|
|
die "Unknown client referenced: $scalar{client}\n"
|
|
unless ($subcli);
|
|
$time = $scalar{"time"};
|
|
if ($subcli->{"time"}) {
|
|
$lastTime = $subcli->{"time"};
|
|
$timeD = $time - $lastTime; # seconds (not steps)
|
|
$lastTime = int ($lastTime / $timeStep); # to timesteps
|
|
if (0 == $timeD) { # final summary case
|
|
$timeD = 1;
|
|
#print "Final update client=$n time=$time\n";
|
|
$time += 1; # so 1 data point gets updated
|
|
}
|
|
} else { # first time report
|
|
$subcli->{"startTime"} = $time;
|
|
$lastTime = 0;
|
|
$timeD = 0; # no time update
|
|
}
|
|
$time = int ($time / $timeStep); # convert to timesteps
|
|
|
|
# now store the scalars we have already seen
|
|
#print "(";
|
|
foreach $k (keys %scalar) {
|
|
#print "$k=$scalar{$k} ";
|
|
$subcli->{$k} = $scalar{$k};
|
|
# Don't bother with time graphs here
|
|
}
|
|
#print ") ";
|
|
}
|
|
|
|
if ($vname =~ m/^\[(.+)\]$/) { # timer
|
|
#print "TIMER $vname '$chunk'\n";
|
|
die "Unknown timer referenced: $vname for client $scalar{client}\n"
|
|
unless ($subcli->{$1});
|
|
die "Invalid timer specified: $ltype->{TIMERS}->{$vname}"
|
|
unless ($ltype->{TIMERS}->{$vname});
|
|
FastTimerParser ($subcli->{$1}, $graphs{$1},
|
|
$lastTime, $time, $timeD,
|
|
$ltype, "TIMERS:$1", $chunk);
|
|
} elsif ($vname =~ m/^\{(.+)\}$/) { # protocol
|
|
#print "PROTOCOL $vname '$chunk'\n";
|
|
die "Unknown protocol referenced: $vname for client $scalar{client}\n"
|
|
unless ($subcli->{$1});
|
|
die "Invalid protocol specified: $ltype->{PROTOCOLS}->{$1}"
|
|
unless ($ltype->{PROTOCOLS}->{$vname});
|
|
|
|
#parseProtocol
|
|
&{$ltype->{"PROTOCOLS:$1:PROTOPARSE"}}
|
|
($subcli->{$1}, $graphs{$1},
|
|
$lastTime, $time, $timeD,
|
|
$ltype, "PROTOCOLS:$1", $chunk);
|
|
} else {
|
|
die "parseLine: Unknown separator $posttext\n";
|
|
}
|
|
} else { # direct assignment
|
|
# Note: we don't graph any scalars at the line level
|
|
#print "$vname='$chunk'\n";
|
|
$scalar{$vname} = $chunk; # store for later
|
|
$subcli->{$k} = $chunk if ($subcli);
|
|
}
|
|
}
|
|
#print "\n";
|
|
|
|
return unless ($timeD); # skip rest if first sample
|
|
|
|
# Now do post processing based on the updated $subcli
|
|
foreach $prot (@protocols) { # figure concurrent connections
|
|
next unless ($subcli->{$prot});
|
|
my $pcli = $subcli->{$prot};
|
|
next unless (($pcli->{"conn"}) && ($pcli->{"conn"}->{"Try"}));
|
|
|
|
my $connD = $pcli->{"conn"}->{"Try"}; # connections minus logouts
|
|
$connD += $pcli->{"reconn"}->{"Try"} if ($pcli->{"reconn"});
|
|
$connD -= $pcli->{"logout"}->{"Try"};
|
|
|
|
$connD -= $pcli->{"total"}->{"Error"}; # subtract sum of errors
|
|
# foreach $k (keys %$pcli) { # subtract errors (which force close)
|
|
# ($k =~ /total/) && next;
|
|
# $connD -= $pcli->{$k}->{"Error"};
|
|
# }
|
|
|
|
#print "DERIVED connections {$prot}\n";
|
|
die "updateGraph: Missing graph 'connections'\n"
|
|
unless ($graphs{$prot}->{"connections"});
|
|
# pass timeD as 1 to avoid time scaling
|
|
updateGraph ($graphs{$prot}->{"connections"},
|
|
$lastTime, $time, 1, 0, $connD);
|
|
}
|
|
}
|
|
|
|
# Walk a format description (recursively)
|
|
# Usage: walkFormatValues (clientHash, formatHash, "LINE", evalExpr)
|
|
# Eval expression is call as follows:
|
|
# value in $a
|
|
# field name in $f
|
|
# field path in $p
|
|
sub walkFormatValues {
|
|
my $cli = shift; # hash of all clients
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string to match
|
|
my $doit = shift; # routine to call
|
|
my $p = shift; # path to variable (may be empty)
|
|
#print "walkFormatValues ($fstr): extra: @_\n" if (@_);
|
|
|
|
my @nlist = @{$ltype->{"$fstr:NAMES"}};
|
|
#print "walkFormatValues ($fstr): @nlist";
|
|
|
|
if ($p) { # initialize path
|
|
$p .= ":";
|
|
} else {
|
|
$p = "";
|
|
}
|
|
|
|
while (@nlist) {
|
|
my $f = shift @nlist; # get field name
|
|
|
|
if ($f =~ m/^\[(.+)\]$/) { # timer
|
|
#print "Timer $f:\n";
|
|
die "Unknown timer referenced: $f for client $scalar{client}\n"
|
|
unless ($cli->{$1});
|
|
die "Invalid timer specified: $ltype->{TIMERS}->{$f}"
|
|
unless ($ltype->{TIMERS}->{$f});
|
|
walkFormatValues ($cli->{$1}, $ltype, "TIMERS:$1",
|
|
$doit, "$p$1", @_);
|
|
} elsif ($f =~ m/^\{(.+)\}$/) { # protocol
|
|
#print "Protocol $f:\n";
|
|
die "Unknown protocol referenced: $f for client $scalar{client}\n"
|
|
unless ($cli->{$1});
|
|
die "Invalid protocol specified: $ltype->{PROTOCOLS}->{$1}"
|
|
unless ($ltype->{PROTOCOLS}->{$f});
|
|
walkFormatValues ($cli->{$1}, $ltype, "PROTOCOLS:$1",
|
|
$doit, "$p$1", @_);
|
|
} else { # direct assignment
|
|
#print "$p$f=$a ";
|
|
#too slow???: eval $doit;
|
|
&$doit ($cli->{$f}, $f, $p, @_);
|
|
}
|
|
}
|
|
#print "\n";
|
|
}
|
|
|
|
# Given a timer format description, break string into name,value chunks
|
|
# Usage: allocTimer (clientsHash, graphHash, lineHash, format)
|
|
sub allocTimerStorage {
|
|
my $clients = shift; # hash of this client
|
|
my $graphs = shift; # hash of graphs
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string to match
|
|
my $sepstr = shift; # separator storage to fill in
|
|
|
|
#print "parseTimer: format='$fstr'\n\tline='$line'\n";
|
|
my $sepf;
|
|
my $remf = $fstr;
|
|
my $chunk;
|
|
my $sepln;
|
|
my $remln = $line;
|
|
my $vname;
|
|
my @tlist = (); # list of text tokens
|
|
my @nlist = (); # list of names
|
|
|
|
# progressively split $fstr into literal chunks
|
|
while ($remf) {
|
|
# remf always looks like <tag><literal text>...
|
|
($vname, $sepf, $remf) = split /([][()+\/\,;:|])/, $remf, 2;
|
|
|
|
if ($remf) { # remln looks like <value><literal text>...
|
|
$sepf =~ s/([][{}*+?^.\/])/\\$1/g; # quote regex syntax
|
|
# push @tlist, qr/$sepf/; # store compiled match expression
|
|
push @tlist, $sepf;
|
|
} else { # remln looks like <value>
|
|
$chunk = $remln;
|
|
}
|
|
push @nlist, $vname;
|
|
#print "vname='$vname' sep='$sepf'\n";
|
|
unless ($graphs->{$vname}) {
|
|
#print "$vname ";
|
|
# This hash that will hold the actual values over time
|
|
$graphs->{$vname} = ArrayInstance->new();
|
|
}
|
|
}
|
|
#print "Timer sep list: @tlist. Names: @nlist\n";
|
|
$ltype->{"$sepstr:SEPS"} = \@tlist;
|
|
$ltype->{"$sepstr:NAMES"} = \@nlist;
|
|
CreateFastTimerParser ($ltype, $sepstr) unless ($timerParser);
|
|
# SIDE EFFECT: updates timerFieldsAll
|
|
@timerFieldsAll = @nlist unless (@timerFieldsAll);
|
|
}
|
|
|
|
# Walk a format discription and create storage hierarchy
|
|
# Also creates the separator and field names lists used everywhere else
|
|
# Some way to precompile the regular expressions (perl 5.005)?
|
|
# Usage: allocStorage (clientsHash, graphHash, lineHash, format, "LINE")
|
|
sub allocStorage {
|
|
my $clients = shift; # hash of this client
|
|
my $graphs = shift; # hash of graphs
|
|
my $ltype = shift; # hash of line parsing info
|
|
my $fstr = shift; # format string to match
|
|
my $sepstr = shift; # separator storage to fill in
|
|
#print "\nallocStorage format='$fstr'\n";
|
|
|
|
my @tlist = (); # list of text tokens
|
|
my @nlist = (); # list of name tokens
|
|
# remove first part of literal text
|
|
my ($posttext, $sepf, $remf) = split /([=\{\[])/, $fstr, 2;
|
|
my $nexttext = $posttext . $sepf;
|
|
$posttext .= $sepf if ($sepf =~ m/=/); # should always happen?
|
|
push @tlist, $posttext; # store initial text too
|
|
|
|
# progressively split $fstr
|
|
my $vname;
|
|
while ($remf) {
|
|
my $lasttext = $nexttext; # last literal text goes with this $vname
|
|
|
|
# Get the variable name
|
|
# remf always looks like <tag><literal text>
|
|
#$remf =~ s/^(\w+)//; $vname = $1; # strip value text off line
|
|
($vname, $sepf, $remf) = split /([^\w])/, $remf, 2; # get value text
|
|
unless ($vname) { # got =[ or ={, go again.
|
|
#print "+$sepf ";
|
|
$nexttext .= $sepf;
|
|
next;
|
|
}
|
|
|
|
$remf = $sepf . $remf # put separator back in to remainder
|
|
unless ($sepf =~ /[\]\}]/); # unless after a timer/proto name
|
|
#print "vname='$vname'\n";
|
|
|
|
# now get the next bit of literal text
|
|
($posttext, $sepf, $remf) = split /([][={}])/, $remf, 2;
|
|
$nexttext = $posttext . $sepf if ($remf); # unless end of line
|
|
|
|
if (($sepf) && ($sepf =~ m/=/)) { # direct assignment
|
|
$posttext .= $sepf; # this is part of literal text
|
|
}
|
|
$posttext =~ s/([][{}*+?^.\/])/\\$1/g; # quote regex syntax
|
|
#print "`$lasttext' "; # this shows some trailing cruft, oops
|
|
#print "remf='$remf'\n";
|
|
# push @tlist, qr/$posttext/; # save separator text
|
|
push @tlist, $posttext; # save separator text
|
|
|
|
if ($lasttext =~ m/[][]/) { # timer
|
|
#print "[$vname] ";
|
|
push @nlist, "[$vname]"; # save field name as timer
|
|
my $nm = "[$vname]";
|
|
die "Invalid timer specified: $vname in '$fstr'"
|
|
unless ($ltype->{TIMERS}->{$nm});
|
|
$clients->{$vname} = ArrayInstance->new(); # create sub hash
|
|
|
|
unless ($graphs->{$vname}) { # create graph
|
|
#print "Creating timer graph '$vname': ";
|
|
$graphs->{$vname} = ArrayInstance->new();
|
|
} else {
|
|
#print "Timer graph '$vname' already exists.";
|
|
}
|
|
allocTimerStorage ($clients->{$vname}, $graphs->{$vname},
|
|
$ltype,
|
|
$ltype->{TIMERS}->{$nm}, "TIMERS:$vname");
|
|
#print "\n"
|
|
} elsif ($lasttext =~ m/[{}]/) { # protocol
|
|
#print "{$vname}\n";
|
|
push @nlist, "{$vname}"; # save field name as protocol
|
|
my $nm = "{$vname}";
|
|
$clients->{$vname} = ArrayInstance->new(); # create sub hash
|
|
die "Invalid protocol specified: $vname"
|
|
unless ($ltype->{PROTOCOLS}->{$nm});
|
|
unless ($graphs->{$vname}) { # create graph protocol
|
|
#print "Creating graph protocol '$vname'\n";
|
|
$graphs->{$vname} = ArrayInstance->new();
|
|
# create generated scalar fields
|
|
$graphs->{$vname}->{"connections"} = ArrayInstance->new();
|
|
}
|
|
# recurse into protocol definition
|
|
# this would allow recursive protocols,
|
|
# but this isn't supported elsewhere
|
|
allocStorage ($clients->{$vname}, $graphs->{$vname},
|
|
$ltype,
|
|
$ltype->{PROTOCOLS}->{$nm}, "PROTOCOLS:$vname");
|
|
|
|
# SIDE EFFECT: updates protocolFields
|
|
unless ($protocolFields{$vname}) {
|
|
my $lst = $ltype->{"PROTOCOLS:$vname:NAMES"};
|
|
$protocolFields{$vname} = $lst;
|
|
#print "$vname fields: @{$lst}\n"; # DEBUG
|
|
}
|
|
CreateFastProtocolParser ($ltype, "PROTOCOLS:$vname")
|
|
unless ($cliLines{"SUMMARY-TIME"}->{"PROTOCOLS:$vname:PROTOPARSE"});
|
|
} elsif ($lasttext =~ m/=/) { # direct assignment
|
|
#print "$vname ";
|
|
push @nlist, $vname; # save field name
|
|
#$clients->{$vname} = 0; # preset scalar field
|
|
unless ($graphs->{$vname}) { # create graph
|
|
#print "Creating value graph '$vname'\n";
|
|
$graphs->{$vname} = ArrayInstance->new();
|
|
}
|
|
} else {
|
|
die "Got lost parsing $fstr\n";
|
|
}
|
|
}
|
|
#print "Line/proto sep list: @tlist\nNames: @nlist\n";
|
|
$ltype->{"$sepstr:SEPS"} = \@tlist;
|
|
$ltype->{"$sepstr:NAMES"} = \@nlist;
|
|
}
|
|
|
|
# These are helper routines to be called by walkFormatValues
|
|
# Each gets called at each format node with value, field name, field path
|
|
sub walkShowVar {
|
|
my $a = shift; my $f = shift; my $p = shift;
|
|
print CSV "$p$f,";
|
|
}
|
|
sub walkShowName {
|
|
my $a = shift;
|
|
print CSV "$a,";
|
|
}
|
|
sub walkCreateFinals {
|
|
my $a = shift; my $f = shift; my $p = shift;
|
|
|
|
if ($p =~ /(\w+):(\w+):$/) {
|
|
$finals{$1}->{$2}= ArrayInstance->new() unless ($finals{$1}->{$2});
|
|
}
|
|
}
|
|
# Add up client data to form total data
|
|
sub walkTotalFinals {
|
|
my $a = shift; my $f = shift; my $p = shift;
|
|
if ($p =~ /(\w+):(\w+):$/) { # sub arrray case
|
|
my $pr = $1; my $tm = $2;
|
|
if (!($finals{$pr}->{$tm}->{$f})) { # first assignment
|
|
$finals{$pr}->{$tm}->{$f} = $a;
|
|
} elsif ($f =~ /Min$/) { # take the new MIN
|
|
$finals{$pr}->{$tm}->{$f} = $a
|
|
if (($a > 0.0) && ($a < $finals{$pr}->{$tm}->{$f}));
|
|
} elsif ($f =~ /Max$/) { # take the new MAX
|
|
$finals{$pr}->{$tm}->{$f} = $a if ($a > $finals{$pr}->{$tm}->{$f});
|
|
} else { # simple sum
|
|
$finals{$pr}->{$tm}->{$f} += $a;
|
|
}
|
|
} elsif ($p =~ /(\w+):$/) { # scalar case, simple sum
|
|
$finals{$1}->{$f} += $a;
|
|
}
|
|
}
|
|
|
|
# Since all timers must be the same
|
|
#@timerFieldsAll # names of all timer fields (in order)
|
|
%protocolFields = (); # protocol as key, hash of lists of fields
|
|
|
|
# This is where the raw data files get read in.
|
|
foreach $section (@workload) {
|
|
next unless ($section->{sectionTitle} =~ /CLIENT/o);
|
|
next unless ($section->{PROCESSES}); # unused client
|
|
|
|
my $slist = $section->{sectionParams};
|
|
$slist =~ s/HOSTS=\s*//; # strip off initial bit
|
|
foreach $cli (split /[\s,]/, $slist) {
|
|
my $clientfile= getClientFilename ($cli, $section);
|
|
# open the output from this child
|
|
open(CLIENTDATA, "<$clientfile") ||
|
|
open(CLIENTDATA, "gunzip -c $clientfile.gz |") ||
|
|
warn "Couldn't open $clientfile:$!\n";
|
|
|
|
# start writing clients.csv file
|
|
fileBackup ("$resultdir/client-$cli.csv");
|
|
open(CSV, ">$resultdir/clients-$cli.csv") # Summary of all clients
|
|
|| die "Could not open $resultdir/client-$cli.csv: $!\n";
|
|
|
|
($params{DEBUG}) && print "Processing $clientfile\n";
|
|
($params{DEBUG}) && print "\tInput start:\t", scalar (localtime), "\n";
|
|
my $numThisClient=0;
|
|
my $linesThisClient=0;
|
|
my $skippedLines=0;
|
|
my $summaryLines=0;
|
|
my $noticeLines=0;
|
|
|
|
%cliLines = (); # line_name as key, hash of info fields
|
|
my %clidata = (); # clear client data store
|
|
|
|
my $cliTimers = ArrayInstance->new(); # timer, format pairs
|
|
my $cliProtocols = ArrayInstance->new(); # protocol, format pairs
|
|
|
|
|
|
# read through, looking for connections and throughput over time
|
|
RAWLINE: while (<CLIENTDATA>) {
|
|
$linesThisClient++;
|
|
|
|
if (/^<FORMAT client=/) { # FORMAT definition
|
|
#print "FORMAT (raw) $_\n";
|
|
s/<\/FORMAT>\s*$//; # strip close format and newline
|
|
s/"//; # strip quotes (Fix emacs) "
|
|
my ($element, $value) = split />/, $_, 2;
|
|
$element =~ s/^<FORMAT //; # strip initial part
|
|
my ($clipair, $typepair) = split /\s/, $element;
|
|
my ($clijunk, $clinum) = split /=/, $clipair;
|
|
my ($type, $label) = split /=/, $typepair;
|
|
|
|
if ($type =~ /TIMER/) {
|
|
unless ($cliTimers->{$label}) { # already exists
|
|
$cliTimers->{$label} = $value;
|
|
($params{DEBUG}) &&
|
|
print "TIMER $label, $value\n";
|
|
#print CSV "<FORMAT client=$clinum TIMER=$label>$value</FORMAT>\n";
|
|
}
|
|
} elsif ($type =~ /PROTOCOL/) {
|
|
unless ($cliProtocols->{$label}) {
|
|
$cliProtocols->{$label} = $value;
|
|
($params{DEBUG}) &&
|
|
print "PROTOCOL $label, $value\n";
|
|
#print CSV "<FORMAT client=$clinum PROTOCOL=$label>$value</FORMAT>\n";
|
|
}
|
|
} elsif ($type =~ /LINE/) {
|
|
# Note: Line types ($label) must be unique
|
|
|
|
unless ($cliLines{$label}) { # already seen
|
|
my ($spat) = split /=/, $value;
|
|
$spat = "^$spat=";
|
|
|
|
($params{DEBUG}) &&
|
|
print "LINE/$spat/ $value\n";
|
|
|
|
#print "LINE short pattern '^$spat='\n";
|
|
# Store all the information about parsing this line
|
|
$cliLines{$label} = ArrayInstance->new();
|
|
$cliLines{$label}->{LINE} = $value;
|
|
# $cliLines{$label}->{PATTERN} = qr/^$spat/;
|
|
$cliLines{$label}->{PATTERN} = "^$spat";
|
|
$cliLines{$label}->{TIMERS} = $cliTimers;
|
|
$cliLines{$label}->{PROTOCOLS} = $cliProtocols;
|
|
#print CSV "<FORMAT client=$clinum LINE=$label>$value</FORMAT>\n";
|
|
} else {
|
|
#print "Skipping already seen line: $label $value\n";
|
|
}
|
|
|
|
# Allocate storage for each client number
|
|
unless ($clidata{$clinum}) {
|
|
$clidata{$clinum} = ArrayInstance->new();
|
|
allocStorage ($clidata{$clinum}, \%graphs,
|
|
$cliLines{$label},
|
|
$cliLines{$label}->{LINE}, "LINE");
|
|
}
|
|
} else {
|
|
print "Unknown FORMAT: line $_\n";
|
|
}
|
|
next;
|
|
}
|
|
|
|
# check most common case first
|
|
if (/$cliLines{"SUMMARY-TIME"}->{PATTERN}/) {
|
|
chomp; # strip newline
|
|
parseLine (\%clidata,
|
|
$cliLines{"SUMMARY-TIME"}, "LINE", $_);
|
|
$summaryLines++;
|
|
next;
|
|
}
|
|
|
|
# Should optimize this dynamic matching, Perl Cookbook 182-185
|
|
foreach $key (keys %cliLines) {
|
|
#print "Checking $cliLines{$key}->{PATTERN}\n";
|
|
next unless (m/$cliLines{$key}->{PATTERN}/);
|
|
#print "\nMatched dynamic line $key: '$cliLines{$key}->{PATTERN}'\n";
|
|
if ($key =~ /^SUMMARY-TIME/) {
|
|
warn "SUMMARY-TIME slipped through. Should never happen\n";
|
|
} elsif ($key =~ /^NOTICE/) {
|
|
$noticeLines++;
|
|
next RAWLINE;
|
|
} elsif ($key =~ /^BLOCK-STATISTICS-/) {
|
|
# ignore for now
|
|
next RAWLINE;
|
|
} else {
|
|
warn "Found format line without hander $key\n";
|
|
last;
|
|
}
|
|
}
|
|
|
|
($params{DEBUG}) && print "skipping $.: $_";
|
|
$skippedLines++;
|
|
next;
|
|
}
|
|
|
|
close(CLIENTDATA);
|
|
($params{DEBUG}) && print "\tInput done:\t", scalar (localtime), "\n";
|
|
|
|
my $pcount = $section->{PROCESSES};
|
|
my $tcount = ($section->{THREADS}) ? $section->{THREADS} : 1;
|
|
$totalProcs += $pcount * $tcount;
|
|
|
|
# Update totals, and dump out client numbers
|
|
my @clist = sort numeric keys %clidata;
|
|
$numThisClient = $#clist+1;
|
|
|
|
$reportingClients += $numThisClient * $tcount;
|
|
|
|
# Write out format description. Note can be different for every client
|
|
walkFormatValues ($clidata{0}, $cliLines{"SUMMARY-TIME"}, "LINE",
|
|
\&walkShowVar);
|
|
print CSV "\n";
|
|
foreach $p (@protocols) { # Create the finals arrays as needed
|
|
$finals{$p} = ArrayInstance->new() unless ($finals{$p});
|
|
}
|
|
|
|
# Create finals arrays (if needed)
|
|
walkFormatValues ($clidata{0}, $cliLines{"SUMMARY-TIME"}, "LINE",
|
|
\&walkCreateFinals);
|
|
foreach $cnum (@clist) {
|
|
my $cn = $clidata{$cnum};
|
|
#print "Total client $cnum\n";
|
|
|
|
# Total finals array. Handle Min and Max special cases
|
|
walkFormatValues ($cn, $cliLines{"SUMMARY-TIME"}, "LINE",
|
|
\&walkTotalFinals);
|
|
|
|
}
|
|
($params{DEBUG}) && print "\tTotals done:\t", scalar (localtime), "\n";
|
|
foreach $cnum (@clist) {
|
|
my $cn = $clidata{$cnum};
|
|
# Write out CSV
|
|
walkFormatValues ($cn, $cliLines{"SUMMARY-TIME"}, "LINE",
|
|
\&walkShowName);
|
|
print CSV "\n";
|
|
}
|
|
($params{DEBUG}) && print "\tCSV done:\t", scalar (localtime), "\n";
|
|
#print "\n";
|
|
|
|
print "Processed: $clientfile: $numThisClient clients\n";
|
|
if (1 || $params{DEBUG}) {
|
|
foreach $cnum (@clist) {
|
|
printf "\tFirst: %d\tFinal: %d\tDuration: %d\n",
|
|
$clidata{$cnum}->{startTime}, $clidata{$cnum}->{"time"},
|
|
$clidata{$cnum}->{"time"} - $clidata{$cnum}->{startTime};
|
|
}
|
|
}
|
|
|
|
print "\t$summaryLines summaries, $noticeLines notices, $skippedLines unknown.\n";
|
|
print CSV "\n";
|
|
close(CSV);
|
|
($params{DEBUG}) && print "Wrote $resultdir/client-$cli.csv\n";
|
|
|
|
}
|
|
}
|
|
|
|
%cliLines = (); # clear storage
|
|
|
|
|
|
unless ($reportingClients > 0) {
|
|
print "No clients reported. Check $resultdir/stderr\n";
|
|
die "Test Failed!";
|
|
}
|
|
|
|
# Find time extent for a key graph
|
|
($startTime, $endTime) = dataMinMax ("blocks", \@protocols,
|
|
$startTime, $endTime);
|
|
|
|
$realTestSecs = ($endTime - $startTime) * $timeStep;
|
|
$realTestSecs = 1 unless ($realTestSecs); # in case of small MaxBlocks
|
|
printf "Reported test duration %d seconds with %d second resolution\n",
|
|
$realTestSecs, $timeStep;
|
|
$realTestSecs = $testsecs if ($realTestSecs > $testsecs);
|
|
|
|
($params{DEBUG})
|
|
&& print "Doing statistical data reduction:\t", scalar (localtime), "\n";
|
|
|
|
|
|
# WRONG: These numbers have already been converted to rate and summed
|
|
# Convert Time2 to standard deviation
|
|
foreach $p (@protocols) {
|
|
my $gp = $graphs{$p};
|
|
foreach $n (@{$protocolFields{$p}}) { # all timers
|
|
my $t = $n; # don't modify original list
|
|
if ($t =~ /^\[(\w+)\]$/) { $t = $1; } # strip off brackets
|
|
next unless ($gp->{$t}); # proto doesn't have this timer
|
|
my $sp = $gp->{$t}->{"Time2"}; # sum of time squared graph pointer
|
|
my $tp = $gp->{$t}->{"Time"}; # sum of time graph pointer
|
|
my $np = $gp->{$t}->{"Try"}; # try graph pointer
|
|
next unless (($sp) && ($tp) && ($gp));
|
|
|
|
#print "Calculating std dev $t for $p\n";
|
|
foreach $tm (keys %$tp) {
|
|
my $n = $np->{$tm};
|
|
my $tot = $sp->{$tm};
|
|
if ($np->{$tm}) {
|
|
my $var = ($sp->{$tm} - (($tot * $tot) / $n)) / $n;
|
|
print "$p->$t var < 0: Time2=$sp->{$tm} Time=$tot n=$n \@$tm\n"
|
|
if (($var < 0) && ($params{DEBUG}));
|
|
|
|
$sp->{$tm} = ($var > 0) ? sqrt ($var) : 0.0;
|
|
} else {
|
|
print "$p->$t: Time2=$sp->{$tm} Time=$tot w/0 tries \@$tm\n"
|
|
if (($tp->{$tm}) || ($sp->{$tm})); # internal error check
|
|
$sp->{$tm} = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
($params{DEBUG}) && print "Doing final data reduction:\t", scalar (localtime), "\n";
|
|
|
|
# divide time graphs by number of tries
|
|
foreach $p (@protocols) {
|
|
my $gp = $graphs{$p};
|
|
foreach $n (@{$protocolFields{$p}}) { # all timers
|
|
my $t = $n; # don't modify original list
|
|
if ($t =~ /^\[(\w+)\]$/) { $t = $1; } # strip off brackets
|
|
next unless ($gp->{$t}); # proto doesn't have this timer
|
|
|
|
my $tp = $gp->{$t}->{"Time"}; # time graph pointer
|
|
my $np = $gp->{$t}->{"Try"}; # try graph pointer
|
|
next unless (($tp) && ($gp)); # should never happen.
|
|
|
|
#print "Ratioing $t for $p\n";
|
|
foreach $tm (keys %$tp) {
|
|
if ($np->{$tm}) {
|
|
$tp->{$tm} /= $np->{$tm} ;
|
|
} else {
|
|
print "$p->$t: $tp->{$tm} time with 0 tries \@$tm\n"
|
|
if ($tp->{$tm}); # internal error check
|
|
$tp->{$tm} = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
print "Saving combined graphs:\t", scalar (localtime), "\n";
|
|
|
|
# Dump graphs into file by protocol
|
|
foreach $p (@protocols) {
|
|
my $gp = $graphs{$p};
|
|
|
|
# Write out data
|
|
fileBackup ("$resultdir/time-$p.csv"); # if processing as we go, backup
|
|
open(CSV, ">$resultdir/time-$p.csv") # Summary of protocol over time
|
|
|| die "Could not open $resultdir/time-$p.csv: $!\n";
|
|
|
|
print CSV "time";
|
|
foreach $t (@{$protocolFields{$p}}) {
|
|
if ($t =~ /^\[(\w+)\]$/) { # Timer case, strip off brackets
|
|
foreach $f (@timerFieldsAll) {
|
|
print CSV ",$p:$1:$f";
|
|
}
|
|
} else {
|
|
print CSV ",$p:$t";
|
|
}
|
|
}
|
|
# note: line print includes initial newline
|
|
|
|
for (my $tm = $startTime; $tm <= $endTime; $tm++) {
|
|
print CSV "\n", $tm-$startTime;
|
|
foreach $t (@{$protocolFields{$p}}) {
|
|
if ($t =~ /^\[(\w+)\]$/) { # Timer case, strip off brackets
|
|
foreach $f (@timerFieldsAll) {
|
|
if ($gp->{$1}->{$f}->{$tm}) {
|
|
print CSV "," . $gp->{$1}->{$f}->{$tm};
|
|
} else {
|
|
print CSV ",0";
|
|
}
|
|
}
|
|
} else {
|
|
if ($gp->{$t}->{$tm}) {
|
|
print CSV "," . $gp->{$t}->{$tm};
|
|
} else {
|
|
print CSV ",0";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
print CSV "\n";
|
|
close(CSV);
|
|
($params{DEBUG}) && print "Wrote $resultdir/time-$p.csv\n";
|
|
|
|
}
|
|
|
|
return 1;
|