]" lines + $sectionName = $1; + } + else { + if ($sectionName eq "ExcludeClass") { + $excludeClass{$_} = 1; + } + elsif ($sectionName eq "ExcludeMessage") { + $excludeMessage{$_} = 1; + } + elsif ($sectionName eq "ExcludeShortName") { + $excludeShortName{$_} = 1; + } + elsif ($sectionName eq "ExcludeIpc") { + $excludeIpc{$_} = 1; + } + elsif ($sectionName eq "ExcludeSingleTuple") { + if ($_ eq "*") { + $excludeAllSingleTuples = 1; + } else { + $excludeSingleTuple{$_} = 1; + } + } + elsif ($sectionName eq "MessageArguments") { + processArgumentLine($_); + } + elsif ($sectionName eq "ObjectNameTruncateAndOrder") { + print $_; + processObjectNameTruncateAndOrder($_); + } + elsif ($sectionName eq "NotableTextToDisplay") { + processNotableText($_); + } + } + } + close INI; + } +} + +sub excludeIpc($) + { + my $ipc = $_[0]; + $ipc =~ s/$.*$$//; # "ESoGetOpt(Socket1)" => "ESoGetOpt" + return $excludeIpc{$ipc}; + } + +printMangleErrors(); + +sub printMangleErrors() + { + if (scalar(@mangled) > 0) { + print STDERR "\n", scalar(@mangled), " possibly mangled log lines:\n"; + foreach my $i (@mangled) { + print STDERR "$i->{num} "; + } + } + print STDERR "\n\n"; + foreach my $i (@mangled) { + my $line = $i->{line}; + # decode node and activity names when printing out the mangled log lines + $line =~ s/\[Address=\[iPtr=0x([0-9a-f]{8})\]/&objectName($1)/ge; + $line =~ s/CNodeActivityBase ([0-9a-f]{8})/"CNodeActivityBase " . $activityName{$1}/ge; + print STDERR $line, "\n\n"; + } + } + +sub handleMangleError($$$) + { + my ($logline, $lineRef, $msg) = @_; + push @mangled, { num => $logline, line => "($msg @ $logline): ..." . ${$lineRef} }; + } + +sub truncateExeName($) + { + my ($exeName) = @_; + $exeName =~ s/\.exe$//; + $exeName =~ s/\.EXE$//; + return $exeName; + } + +sub outputSymbols() + { + open SYM, ">logsym.html" || die "Cannot open logsym.html for writing\n"; + print SYM "\n

\n";
+	my @keys = sort keys %symtab;
+	for my $i (@keys) {
+		print SYM "$i\t$symtab{$i}
\n";
+		}
+	print SYM "

\n"; + close SYM; + } + +# +# Process a single line from the "[Arguments]" section of the config file. +# This section contains a list of messages and the corresponding message arguments to display. +# +# Format: +# []* +# where: +# := [.]*[:] +# := "node" +# := class data member name (e.g. iStateChange.iError) +# +# Output format values: +# node take the hex address as a node address and display the human readable node name (e.g. "IPCPR2") +# By default, display as signed decimal. +# +# For example: +# +# [Arguments] +# StateChange iStateChange.iStage iStateChange.iError +# BindTo iCommsBinder.iCommsId.iPtr:node iProviderInfo.iAPId +# SelectComplete iNodeId.iPtr:node +# +# Each line is read into the hash %argument which is keyed on message name and contains a (mixed type) array +# giving each argument (in corresponding Perl hash access format) and output format (constant ArgumentSignedDecimal, +# ArgumentNode). For example: +# +# %arguments: StateChange => [ "{iStateChange}->{iStage}", ArgumentSignedDecimal, "{iStateChange}->{iError}", ArgumentSignedDecimal ] +# BindTo => [ "{iCommsBinder}->{iCommsId}->{iPtr}", ArgumentNode, "{iProviderInfo}->{iAPId}", ArgumentSignedDecimal ] + + +sub processArgumentLine($) +{ + my $line = $_[0]; + if (!($line =~ s/^(\w+)\s*//)) { + die "Incorrectly formatted arguments file\n"; + } + my $msg = $1; + if (exists $arguments{$msg}) { + die "Duplicate line for message $msg in arguments file\n"; + } + my @args = split ' ', $line; + my $format; + foreach my $i (@args) { + # extract the output format specifier after the ":" (if any) - e.g. "iPtr:node". + # Default to signed decimal, if not specified. + if ($i =~ s/:(\w+)//) { + $format = $argumentFormatToConstant{$1}; + } else { + $format = ArgumentSignedDecimal; + } + # convert from period seperated fields to Perl hash access format, e.g. "a.b.c" to "$h->{a}->{b}->{c}" + $i =~ s/(\w+)/{\1}/g; + $i =~ s/\./->/g; + # add hash access string and output format to array associated with the message + push @{$arguments{$msg}}, ($i,$format); + } +# printArguments(); +} + +# +# Convert the nested bracketted field/value format used by the decoder into a Perl hash. +# For example: +# "[A=[B=[C=x1][D=x2]][E=x3]][F=[G=x4]]" +# becomes: +# "{A => { B=C => x1, D => x2, }, E => x3, }, F => {G => x4, }, }" +# Note: extraneous commas are harmless and hence not removed. +# +# This is then passed to "eval" to become an actual hash. Accessing any field is then via standard Perl hash access, +# e.g. "$hash->{A}->{B}->{D}" for accessing A.B.D. +# +# Arguments: +# - decoder nested bracketted format string for arguments +# Return: +# - reference to hash + +sub convertDecoderArgumentsToPerlHash($) +{ + my $arg = "{" . $_[0]; + # Remove any empty fields, e.g. "[Bad=]" as these will result in us generating hash initialisers without a value + # (e.g. "..., Good => Value, Bad => , Good2 => Value2, ...") which causes undefined behaviour when initialising + # the hash. + + $arg =~ s/\[\w+=\]\s*//g; + + # NOTE: order in which the substitutions happens below is important + + # "[X=[" -> "X => { " + $arg =~ s/\[(\w+)=\[/\1 => { /g; + + # "X=[" -> "X => { " + $arg =~ s/(\w+)=\[/\1 => { /g; + + # "[X=Y]" -> "X => Y, " + # Note: allows for empty values, e.g. "[A=]" +# $arg =~ s/\[(\w+)=(\w*)\]/\1 => \2, /g; + $arg =~ s/\[([^\]=]+)=([^\]=]*)\]/\1 => \2, /g; + + # "X=Y]" -> "X => Y, " + # Note: allows for empty values, e.g. "[A=]" +# $arg =~ s/[^[](\w+)=(\w*)\]/\1 => \2, /g; +# $arg =~ s/[^\[]([^\]\=]+)\=([^\>][^\]\=]*)\]/\1 \=> \2, /g; + $arg =~ s/([\w\d_]+)\s*\=([^\>][^\]\=]*)\]/\1 \=> \2, /g; + + # "]" -> "}, " + $arg =~ s/\]/}, /g; + + # "[" -> "{ " + $arg =~ s/\[/{ /g; + + # KLUDGE: " , " becomes " } ". This is mainly to deal with placing the correct number + # of "}" at the end. + $arg =~ s/ , / } /g; + + $arg .= "}"; + + # we must quote any non-numeric values. Not an ideal expression - just looks at first character. +# $arg =~ s/=> ([^{][a-zA-Z]+),/=> "\1",/g; + $arg =~ s/=> ([^{,]+),/=> "\1",/g; + return eval $arg; +} + +# +# Process Object name truncation and ordering lines from ini file. +# +# Each line contains: +# _{+#
+# each occurrence of in any object name is replaced with .
+# indicates how objects containing are placed on the display.
+#
+
+sub processObjectNameTruncateAndOrder($_)
+{
+ my $line = $_[0];
+ my ($substr, $replacement, $order) = split ' ', $line;
+ push @objectNameParse, { SubString => $substr, Replacement => $replacement, Order => $order };
+}
+
+sub printRecursiveHash($)
+{
+ print "Printing hash: ";
+ printRecursiveHashWorker($_[0]);
+ print "\n\n";
+}
+
+sub printRecursiveHashWorker($)
+{
+ my $hashRef = $_[0];
+ foreach my $i (keys %{$hashRef}) {
+ print "$i => ";
+ my $type = ref($hashRef->{$i});
+ if ($type eq "HASH") {
+ print "{ ";
+ printRecursiveHashWorker($hashRef->{$i});
+ print "}, ";
+ } else {
+ print $hashRef->{$i}, ", ";
+ }
+ }
+}
+
+sub printArguments()
+{
+ print "Arguments:\n";
+ foreach my $key (keys %arguments) {
+ print "$key: @{$arguments{$key}}\n";
+ }
+}
+
+sub processNotableText($)
+{
+ my $text = $_[0];
+ my ($matchText,$displayText) = m/"(.*)"\s*"(.*)"/;
+ push @notableText, [ $matchText, $displayText ];
+}
+
+sub matchNotableText($)
+{
+ my $text = $_;
+ foreach my $ref (@notableText) {
+ if ($text =~ m/$ref->[0]/) {
+ return $ref->[1];
+ }
+ }
+ return "";
+}
+
+sub ClearActivity($)
+{
+ my $actAddr = $_[0];
+ if (defined $activityNode{$actAddr}) {
+ delete $activityNode{$actAddr};
+ }
+ if (defined $activityName{$actAddr}) {
+ delete $activityName{$actAddr};
+ }
+}
\ No newline at end of file}