tests/filter_xml_frames

   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;