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 11 use strict; 12 use warnings; 13 14 my $in_frame = 0; 15 my $frame = ""; 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... 21 22 while (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 54 exit 0; 55
