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