1#! /usr/bin/env perl
2
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...
10
11use strict;
12use warnings;
13
14my $in_frame = 0;
15my $frame = "";
16
17# Info about the current frame
18my $has_source_info   = 0;    # <dir>, <file>, <line>
19my $has_function_name = 0;    # <fn>
20my $has_system_obj    = 0;    # <obj>/lib...   or  <obj>/usr/lib...
21
22while (my $line = <>)
23{
24    if (! $in_frame) {
25        if ($line =~ /<frame>/) {
26            $frame = $line;
27            $in_frame = 1;
28            $has_source_info = $has_function_name = $has_system_obj = 0;
29        } else {
30            print $line;
31        }
32        next;
33    }
34
35# We're in a frame
36    $frame .= $line;
37    if ($line =~ /<\/frame>/) {
38# Is this a frame we want to keep?
39        my $ignore_frame = $has_system_obj ||
40            (! $has_source_info && ! $has_function_name);
41        if (! $ignore_frame) {
42            print $frame;
43        }
44        $in_frame = 0;
45    } else {
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/);
51    }
52}
53
54exit 0;
55