florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 1 | #! /usr/bin/env perl |
| 2 | |
florian | 73523fd | 2013-09-18 09:15:23 +0000 | [diff] [blame] | 3 | # Remove certain <frame>.....</frame> records that are suspected to point |
| 4 | # to some kind of system library. Those are |
| 5 | # - frames with <obj>/lib/.... |
| 6 | # - frames with <obj>/usr/lib/.... |
| 7 | # - frames without source informatino and without a function name |
| 8 | # |
| 9 | # There may be others... |
florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 10 | |
| 11 | use strict; |
| 12 | use warnings; |
| 13 | |
| 14 | my $in_frame = 0; |
| 15 | my $frame = ""; |
florian | 73523fd | 2013-09-18 09:15:23 +0000 | [diff] [blame] | 16 | |
| 17 | # Info about the current frame |
| 18 | my $has_source_info = 0; # <dir>, <file>, <line> |
| 19 | my $has_function_name = 0; # <fn> |
| 20 | my $has_system_obj = 0; # <obj>/lib... or <obj>/usr/lib... |
florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 21 | |
| 22 | while (my $line = <>) |
| 23 | { |
| 24 | if (! $in_frame) { |
| 25 | if ($line =~ /<frame>/) { |
| 26 | $frame = $line; |
| 27 | $in_frame = 1; |
florian | 73523fd | 2013-09-18 09:15:23 +0000 | [diff] [blame] | 28 | $has_source_info = $has_function_name = $has_system_obj = 0; |
florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 29 | } else { |
| 30 | print $line; |
| 31 | } |
| 32 | next; |
| 33 | } |
| 34 | |
| 35 | # We're in a frame |
| 36 | $frame .= $line; |
| 37 | if ($line =~ /<\/frame>/) { |
florian | 73523fd | 2013-09-18 09:15:23 +0000 | [diff] [blame] | 38 | # Is this a frame we want to keep? |
| 39 | my $ignore_frame = $has_system_obj || |
| 40 | (! $has_source_info && ! $has_function_name); |
florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 41 | if (! $ignore_frame) { |
| 42 | print $frame; |
| 43 | } |
| 44 | $in_frame = 0; |
| 45 | } else { |
florian | 73523fd | 2013-09-18 09:15:23 +0000 | [diff] [blame] | 46 | $has_source_info = 1 if ($line =~ /<(dir|file|line)>/); |
| 47 | $has_function_name = 1 if ($line =~ /<fn>/); |
| 48 | # This may require tweaking; currently /lib and /usr/lib are matched |
| 49 | $has_system_obj = 1 if ($line =~ /<obj>\/lib/); |
| 50 | $has_system_obj = 1 if ($line =~ /<obj>\/usr\/lib/); |
florian | c5325ef | 2013-09-17 20:15:36 +0000 | [diff] [blame] | 51 | } |
| 52 | } |
| 53 | |
| 54 | exit 0; |