1 files changed, 117 insertions, 0 deletions
diff --git a/scripts/rtfl-stacktraces b/scripts/rtfl-stacktraces
new file mode 100755
index 0000000..a9e953b
--- /dev/null
+++ b/scripts/rtfl-stacktraces
@@ -0,0 +1,117 @@
+#!/usr/bin/perl
+
+# RTFL
+#
+# Copyright 2014 Sebastian Geerken <sgeerken@dillo.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Usage: rtfl-stracktraces <method name>
+#
+# Prints stacktraces which lead to a specific method given as command line
+# argument (based on "obj-enter" and "obj-leave").
+#
+# Further Arguments:
+#
+# -s        Short format.
+# -n <n>    Regard only stacktraces with at least <n> occurences of the method.
+# -e <n>    Do not print stack traces, but all messages; if a stacktrace would
+#           have been printed, exit after <n> further messages. Can be used
+#           together with -m.
+# -m <mark> Do not print stack traces, but all messages; if a stacktrace would
+#           have been printed, edit a obj-mark with all parameters (file name,
+#           line number, process id, object, aspect, priority) taken from the
+#           last "obj-enter" command. Can be used together with -e.
+#
+# N. b. that parsing is incorrect, see <doc/rtfl.html#scripts>.
+
+sub helpAndExit { 
+   die "Syntax: $0 [-s] [-n <n>] [-e <n>] [-m <mark>] <method name>";
+}
+
+$method = "";
+$short = 0;
+$minNumCalls = 1;
+$willEnd = 0;
+$willEndCount = 0;
+$mark = "";
+
+for ($i = 0; $i < scalar @ARGV; $i++) {
+   if ($ARGV[$i] eq "-s") {
+      $short = 1;
+   } elsif ($ARGV[$i] eq "-n") {
+      helpAndExit if ($i == scalar @ARGV -1);
+      $minNumCalls = $ARGV[++$i];
+   } elsif ($ARGV[$i] eq "-e") {
+      helpAndExit if ($i == scalar @ARGV -1);
+      $willEnd = 1;
+      $willEndCount = $ARGV[++$i];
+   } elsif ($ARGV[$i] eq "-m") {
+      helpAndExit if ($i == scalar @ARGV -1);
+      $mark = $ARGV[++$i];
+   } else {
+      $method = $ARGV[$i];
+   }
+}
+
+helpAndExit if ($method eq "");
+
+@stack = ();
+$first = 1;
+$numCalls = 0;
+
+while(<STDIN>) {
+   if (($mark ne "" || $willEnd) && (!$endSoon || $endCount > 0)) {
+      print;
+      if ($endSoon && /^\[rtfl[^\]]*\]/) { $endCount--; };
+   }
+
+   if (/^(\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*):(obj-)?enter:([^:]*:[^:]*:[^:]*):([^:]*):.*$/) {
+      push @stack, ($short ? $4 : $_);
+      
+      if ($4 eq $method) {
+         $numCalls++;
+
+         if ($numCalls >= $minNumCalls) {
+            if ($willEnd) {
+               if (!$endSoon) {
+                  $endSoon = 1;
+                  $endCount = $willEndCount;
+               }
+            } elsif ($mark ne "") {
+               print "$2:(obj-)?mark:$3:$mark\n";
+            } else {
+               if ($short) {
+                  $firstInLine = 1;
+                  foreach $frame (@stack) {
+                     print " > " unless $firstInLine;
+                     print $frame;
+                     $firstInLine = 0;
+                  }
+                  print "\n";
+               } else {
+                  print "-" x 79, "\n" unless $first;
+                  foreach $frame (@stack) { print $frame; }
+               }
+               $first = 0;
+            }
+         }
+      }
+   } elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?leave:.*$/) {
+      $l = pop @stack;
+      if ($l =~
+          /^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?enter:[^:]*:[^:]*:[^:]*:$method:.*$/)
+      { $numCalls--; }
+   }
+}