Adding upstream version 124.0.1.upstream/124.0.1

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 44 insertions, 0 deletions

diff --git a/tools/rb/filter-log.pl b/tools/rb/filter-log.pl
new file mode 100755
index 0000000000..4a1f66741b
--- /dev/null
+++ b/tools/rb/filter-log.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+# Filter a refcount log to show only the entries for a single object.
+# Useful when manually examining refcount logs containing multiple
+# objects.
+
+use 5.004;
+use strict;
+use Getopt::Long;
+
+GetOptions("object=s");
+
+$::opt_object ||
+     die qq{
+usage: filter-log-for.pl < logfile
+  --object <obj>         The address of the object to examine (required)
+};
+
+warn "object $::opt_object\n";
+
+LINE: while (<>) {
+    next LINE if (! /^</);
+    my $line = $_;
+    my @fields = split(/ /, $_);
+
+    my $class = shift(@fields);
+    my $obj   = shift(@fields);
+    next LINE unless ($obj eq $::opt_object);
+    my $sno   = shift(@fields);
+    my $op  = shift(@fields);
+    my $cnt = shift(@fields);
+
+    print $line;
+
+    # The lines in the stack trace
+    CALLSITE: while (<>) {
+        print;
+        last CALLSITE if (/^$/);
+    }
+}