in automation/tinc/main/ext/explain.pl [639:892]
sub analyze_node
{
my ($node, $parse_ctx) = @_;
if (defined($node) && exists($node->{txt}))
{
# gather analyze statistics if it exists in this node...
if ($node->{txt} =~
m/Slice\s+statistics.*(Settings.*)*Total\s+runtime/s)
{
my $t1 = $node->{txt};
# NOTE: the final statistics look something like this:
# Slice statistics:
# (slice0) Executor memory: 472K bytes.
# (slice1) Executor memory: 464K bytes avg x 2 workers, 464K bytes max (seg0).
# Settings:
# Total runtime: 52347.493 ms
# (we've actually added some vertical bars so it might look
# like this):
# || Slice statistics:
# || (slice0) Executor memory: 472K bytes.
# NB: the "Settings" entry is optional, so
# add Settings if they are missing
unless ($t1 =~
m/Slice\s+statistics.*Settings.*Total\s+runtime/s)
{
$t1 =~
s/\n.*\s+Total\s+runtime/\n Settings\: \n Total runtime/;
}
my @foo = ($t1 =~ m/Slice\s+statistics\:\s+(.*)\s+Settings\:\s+(.*)\s+Total\s+runtime:\s+(.*)\s+ms/s);
if (scalar(@foo) == 3)
{
my $mem = shift @foo;
my $sett = shift @foo;
my $runt = shift @foo;
$mem =~ s/\|\|//gm; # remove '||'...
$sett =~ s/\|\|//gm;
my $statstuff = {};
my @baz = split(/\n/, $mem);
my $sliceh = {};
for my $elt (@baz)
{
my @ztesch = ($elt =~ m/(slice\d+)/);
next unless (scalar(@ztesch));
$elt =~ s/\s*\(slice\d+\)\s*//;
my $val = shift @ztesch;
$sliceh->{$val} = $elt;
}
$statstuff->{memory} = $sliceh;
$statstuff->{settings} = $sett;
$statstuff->{runtime} = $runt;
$parse_ctx->{explain_analyze_stats} = $statstuff;
$node->{statistics} = $statstuff;
}
}
my @short = $node->{txt} =~ m/\-\>\s*(.*)\s*\(cost\=/;
$node->{short} = shift @short;
unless(exists($node->{id}))
{
print Data::Dumper->Dump([$node]), "\n";
}
if ($node->{id} == 1)
{
@short = $node->{txt} =~ m/^\s*\|\s*(.*)\s*\(cost\=/;
$node->{short} = shift @short;
# handle case where dashed line might have wrapped...
unless (defined($node->{short}) && length($node->{short}))
{
# might not be first line...
@short = $node->{txt} =~ m/\s*\|\s*(.*)\s*\(cost\=/;
$node->{short} = shift @short;
}
}
# handle case of "cost-free" txt (including a double ||
# and not first line, or screwed-up parse of short as a single bar
#
# example: weird initplan like:
# || -> InitPlan (slice49)
if (defined($node->{short}) && length($node->{short})
&& ($node->{short} =~ m/\s*\|\s*/))
{
$node->{short} = "";
}
unless (defined($node->{short}) && length($node->{short}))
{
@short = $node->{txt} =~ m/\s*\|(\|)?\s*(\w*)\s*/;
$node->{short} = shift @short;
if (defined($node->{short}) && length($node->{short})
&& ($node->{short} =~ m/\s*\|\s*/))
{
$node->{short} = "";
}
# last try!!
unless (defined($node->{short}) && length($node->{short}))
{
my $foo = $node->{txt};
$foo =~ s/\-\>//gm;
$foo =~ s/\|//gm;
$foo =~ s/^\s+//gm;
$foo =~ s/\s+$//gm;
$node->{short} = $foo;
}
# print "long: $node->{txt}\n";
# print "short: $node->{short}\n";
}
$node->{short} =~ s/\s*$//;
# remove quotes which mess up dot file
$node->{short} =~ s/\"//gm;
# print "long: $node->{txt}\n";
# print "short: $node->{short}\n";
# XXX XXX XXX XXX: FINAL "short" fixups
while (defined($node->{short}) && length($node->{short})
&& ($node->{short} =~ m/(\n)|^\s+|\s+$|(\(cost\=)/m))
{
# remove leading and trailing spaces...
$node->{short} =~ s/^\s*//;
$node->{short} =~ s/\s*$//;
# remove newlines
$node->{short} =~ s/(\n).*//gm;
# remove cost=...
$node->{short} =~ s/\(cost\=.*//gm;
# print "short fixup: $node->{short}\n\n\n";
}
{
if ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*end)/i)
{
my @ggg =
($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*end)/i);
# print join('*', @ggg), "\n";
my $tt = $ggg[0];
$node->{to_end} = $tt;
$parse_ctx->{alltimes}->{$tt} = 1;
if (exists($parse_ctx->{h_to_end}->{$tt}))
{
push @{$parse_ctx->{h_to_end}->{$tt}}, '"'. $node->{id} .'"';
}
else
{
$parse_ctx->{h_to_end}->{$tt} = ['"'. $node->{id} . '"'];
}
}
if ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*first\s*row)/i)
{
my @ggg =
($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*first\s*row)/i);
# print join('*', @ggg), "\n";
my $tt = $ggg[0];
$node->{to_first} = $tt;
$parse_ctx->{alltimes}->{$tt} = 1;
if (exists($parse_ctx->{h_to_first}->{$tt}))
{
push @{$parse_ctx->{h_to_first}->{$tt}}, '"' . $node->{id} . '"' ;
}
else
{
$parse_ctx->{h_to_first}->{$tt} = [ '"' . $node->{id} . '"'];
}
}
if ($node->{txt} =~ m/start offset by (\d+(\.\d*)?)(\s*ms)/i)
{
my @ggg =
($node->{txt} =~ m/start offset by (\d+(\.\d*)?)(\s*ms)/i);
# print join('*', @ggg), "\n";
my $tt = $ggg[0];
$node->{to_startoff} = $tt;
$parse_ctx->{allstarttimes}->{$tt} = 1;
if (exists($parse_ctx->{h_to_startoff}->{$tt}))
{
push @{$parse_ctx->{h_to_startoff}->{$tt}}, '"'. $node->{id} .'"';
}
else
{
$parse_ctx->{h_to_startoff}->{$tt} = ['"'. $node->{id} . '"'];
}
}
if (exists($node->{to_end}))
{
$node->{total_time} =
(exists($node->{to_first})) ?
($node->{to_end} - $node->{to_first}) :
$node->{to_end};
}
}
if (1)
{
if (exists($node->{child}))
{
delete $node->{child}
unless (defined($node->{child})
&& scalar(@{$node->{child}}));
}
}
}
}