# 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 # Marcel DePaolis # # 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 ... ($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 $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 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 $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}; # Dont 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: Unkown separator $posttext\n"; } } else { # direct assignment # Note: we dont 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; # seperator 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 ... ($vname, $sepf, $remf) = split /([][()+\/\,;:|])/, $remf, 2; if ($remf) { # remln looks like ... $sepf =~ s/([][{}*+?^.\/])/\\$1/g; # quote regex syntax # push @tlist, qr/$sepf/; # store compiled match expression push @tlist, $sepf; } else { # remln looks like $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 seperator 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; # seperator 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 #$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 seperator 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 seperator text push @tlist, $posttext; # save seperator 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 isnt 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 () { $linesThisClient++; if (/^\s*$//; # strip close format and newline s/"//; # strip quotes (Fix emacs) " my ($element, $value) = split />/, $_, 2; $element =~ s/^{$label}) { # already exists $cliTimers->{$label} = $value; ($params{DEBUG}) && print "TIMER $label, $value\n"; #print CSV "$value\n"; } } elsif ($type =~ /PROTOCOL/) { unless ($cliProtocols->{$label}) { $cliProtocols->{$label} = $value; ($params{DEBUG}) && print "PROTOCOL $label, $value\n"; #print CSV "$value\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 "$value\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; # dont modify original list if ($t =~ /^\[(\w+)\]$/) { $t = $1; } # strip off brackets next unless ($gp->{$t}); # proto doesnt 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; # dont modify original list if ($t =~ /^\[(\w+)\]$/) { $t = $1; } # strip off brackets next unless ($gp->{$t}); # proto doesnt 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;