contrib/log2xml.pl

   1 #!/usr/bin/perl -w
   2 # ======================================================================
   3 # log2xml - This script translates cacao -verbosecall ouput into a
   4 #           more readable XML format. It also separates the output of
   5 #           different threads and is able to ignore commonly called
   6 #           (uninteresting) methods.
   7 #
   8 # Usage:
   9 #     cacao -verbose -verbosecall ... | log2xml.pl
  10 #
  11 # For each thread the script writes a file LOG_{threadid}.xml.
  12 #
  13 # You can use any XML editor to browse the logs. If you want to use
  14 # vim, which works well, take a look at log2xml.vim in this
  15 # directory.
  16 #
  17 # You may want to edit the opt_ignore options below.
  18 #
  19 # Author  : Edwin Steiner
  20 # Revision: $Id: log2xml.pl 2305 2005-04-14 20:10:20Z edwin $
  21 #
  22 # $Log$
  23 # Revision 1.2  2005/04/14 20:10:20  edwin
  24 # disabled debug print, added vim boilerplate
  25 #
  26 # Revision 1.1  2005/04/14 19:44:00  edwin
  27 # added log2xml.pl and log2xml.vim
  28 #
  29 # ======================================================================
  30
  31 use strict;
  32 use IO::File;
  33
  34 my @opt_ignorelist = (
  35         'java.lang.Character.toLowerCase(C)C',
  36         'java.lang.Character.toUpperCase(C)C',
  37         'java.lang.String.endsWith(Ljava/lang/String;)Z',
  38         'java.lang.String.equalsIgnoreCase(Ljava/lang/String;)Z',
  39         'java.lang.String.equals(Ljava/lang/Object;)Z',
  40         'java.lang.String.indexOf(I)I',
  41         'java.lang.String.indexOf(II)I',
  42         'java.lang.String.indexOf(Ljava/lang/String;)I',
  43         'java.lang.String.indexOf(Ljava/lang/String;I)I',
  44         'java.lang.String.lastIndexOf(Ljava/lang/String;)I',
  45         'java.lang.String.lastIndexOf(Ljava/lang/String;I)I',
  46         'java.lang.String.regionMatches(ILjava/lang/String;II)Z',
  47         'java.lang.String.regionMatches(ZILjava/lang/String;II)Z',
  48         'java.lang.String.replace(CC)Ljava/lang/String;',
  49         'java.lang.String.startsWith(Ljava/lang/String;)Z',
  50         'java.lang.String.substring(II)Ljava/lang/String;',
  51         'java.lang.String.toLowerCase()Ljava/lang/String;',
  52         'java.util.HashMap.get(Ljava/lang/Object;)Ljava/lang/Object;',
  53         'java.util.HashMap.put(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;',
  54         'java.util.Hashtable.clone()Ljava/lang/Object;',
  55         'java.util.Hashtable.get(Ljava/lang/Object;)Ljava/lang/Object;',
  56         'java.util.Hashtable.put(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;',
  57         'java.util.jar.JarFile$EntryInputStream.read([BII)I',
  58 );
  59
  60 my @opt_ignore_regexps = (
  61         qr/^java\.lang\.Character\./,
  62         qr/^java\.lang\.String\./,
  63         qr/^java\.util\.jar\./,
  64         qr/^java\.util\.Locale\./,
  65         qr/^java\.util\.zip\./,
  66 );
  67
  68 my $opt_details = 0;
  69 my $opt_verbose = 1;
  70 my $opt_no_text_for_ignored = 0;
  71 my $opt_fileprefix = 'LOG_';
  72
  73 # per-thread hashes
  74 my %stacks;
  75 my %files;
  76 my %ignore_level;
  77
  78 my %ignorehash = map { $_=>1 } @opt_ignorelist;
  79
  80 # ======================================================================
  81 # OUTPUT, XML WRITING
  82 # ======================================================================
  83
  84 # Quote the given text for putting it in an XML file.
  85 sub quote ( $ )
  86 {
  87         my ($s) = @_;
  88         $s =~ s/&/&amp;/g;
  89         $s =~ s/</&lt;/g;
  90         $s =~ s/>/&gt;/g;
  91         return $s;
  92 }
  93
  94 sub write_xml ( $$ )
  95 {
  96         my ($thread,$xml) = @_;
  97         my $file = $files{$thread};
  98         print $file $xml;
  99 }
 100
 101 sub write_xml_call_info ( $$ )
 102 {
 103         my ($thread,$node) = @_;
 104         my $file = $files{$thread};
 105         print $file ' return="' . quote($node->{RETURN}) . '"' if defined($node->{RETURN});
 106         print $file ' except="' . quote($node->{EXCEPTION}) . '"' if defined($node->{EXCEPTION});
 107         if ($opt_details) {
 108                 print $file ' details="' . quote($node->{DETAILS}) . '"' if defined($node->{DETAILS});
 109         }
 110 }
 111
 112 sub write_xml_frame ( $$ )
 113 {
 114         my ($thread,$node) = @_;
 115
 116         my $file = $files{$thread};
 117         print $file '<frame name="' . quote($node->{NAME}) . '"';
 118         write_xml_call_info($thread,$node);
 119         print $file "/>\n";
 120 }
 121
 122 sub write_xml_enter ( $$ )
 123 {
 124         my ($thread,$node) = @_;
 125
 126         my $file = $files{$thread};
 127         print $file '<call name="' . quote($node->{NAME}) . '"';
 128         write_xml_call_info($thread,$node);
 129         print $file ">\n";
 130 }
 131
 132 sub write_xml_leave ( $$ )
 133 {
 134         my ($thread,$node) = @_;
 135
 136         my $file = $files{$thread};
 137         print $file '<leave';
 138         write_xml_call_info($thread,$node);
 139         print $file ' name="' . quote($node->{NAME}) . '"';
 140         print $file "/>\n";
 141         print $file "</call>\n";
 142 }
 143
 144 sub write_xml_node ( $$ )
 145 {
 146         my ($thread,$node) = @_;
 147
 148         write_xml_enter($thread,$node);
 149         write_xml_body($thread,$node);
 150         write_xml_leave($thread,$node);
 151 }
 152
 153 sub write_xml_body ( $$ )
 154 {
 155         my ($thread,$node) = @_;
 156
 157         for my $x (@{$node->{BODY}}) {
 158                 if (ref $x) {
 159                         write_xml_node($thread,$x);
 160                 }
 161                 else {
 162                         my $file = $files{$thread};
 163                         print $file $x;
 164                 }
 165         }
 166 }
 167
 168 sub write_xml_header ( $ )
 169 {
 170         my ($file) = @_;
 171         print $file '<?xml version="1.0"?>'."\n";
 172 }
 173
 174 sub write_xml_end ( $ )
 175 {
 176         my ($file) = @_;
 177 }
 178
 179 # ======================================================================
 180 # HELPERS
 181 # ======================================================================
 182
 183 # Return true if functions with this name are ignored.
 184 sub is_ignored ( $ )
 185 {
 186         my ($name) = @_;
 187
 188         return 1 if $ignorehash{$name};
 189
 190         for my $re (@opt_ignore_regexps) {
 191                 return 1 if $name =~ $re;
 192         }
 193
 194         return 0;
 195 }
 196
 197 # ======================================================================
 198 # STACK RECONSTRUCTION
 199 # ======================================================================
 200
 201 sub make_root ( )
 202 {
 203         return {NAME => 'root',
 204                         DETAILS => '',
 205                         BODY => [],
 206                         RETURN => undef,
 207                         EXCEPTION => undef,
 208                         LINE => undef,
 209                         };
 210 }
 211
 212 sub thread_register ( $ )
 213 {
 214         my ($thread) = @_;
 215         unless (exists $stacks{$thread}) {
 216                 $stacks{$thread} = [make_root];
 217                 my $filename = $opt_fileprefix . $thread . '.xml';
 218                 $files{$thread} = IO::File->new(">$filename");
 219                 $ignore_level{$thread} = 0;
 220                 write_xml_header($files{$thread});
 221         }
 222 }
 223
 224 sub stack_top ( $ )
 225 {
 226         my ($thread) = @_;
 227         return $stacks{$thread}->[-1] or die "stack underflow";
 228 }
 229
 230 sub stack_pop ( $ )
 231 {
 232         my ($thread) = @_;
 233         return pop @{$stacks{$thread}} or die "stack underflow";
 234 }
 235
 236 sub stack_push ( $$ )
 237 {
 238         my ($thread,$value) = @_;
 239         push @{$stacks{$thread}},$value;
 240 }
 241
 242 sub stack_slot ( $$ )
 243 {
 244         my ($thread,$index) = @_;
 245         return $stacks{$thread}->[$index] or die "invalid stack index";
 246 }
 247
 248 sub stack_write ( $ )
 249 {
 250         my ($thread) = @_;
 251         print STDERR "$.\n";
 252         for (@{$stacks{$thread}}) {
 253                 print STDERR "\t".quote($_->{NAME})."\n";
 254         }
 255 }
 256
 257 sub process_call ( $$$ )
 258 {
 259         my ($thread,$keyword,$rest) = @_;
 260
 261         my $top = stack_top($thread);
 262
 263         $rest =~ /(\S+?)  \( ([^)]*) \)  ([^ \t(]+)  (.*) $/x or die "could not match call log: $rest";
 264         my ($n,$args,$rettype,$details) = ($1,$2,$3,$4);
 265         my $name = "$n($args)$rettype";
 266
 267         my $call = {NAME => $name,SHORTNAME => $n,DETAILS => $details,BODY => [],LINE => $.};
 268
 269         $call->{FIRST} = 1 if $keyword eq '1st_call';
 270
 271         stack_push($thread,$call);
 272
 273         if ($ignore_level{$thread} == 0) {
 274                 write_xml_enter($thread,$call);
 275
 276                 if (is_ignored($name)) {
 277                         $ignore_level{$thread}++;
 278                 }
 279         }
 280         else {
 281                 $ignore_level{$thread}++;
 282         }
 283 }
 284
 285 sub process_leave ( $$$ )
 286 {
 287         my ($thread,$rest,$exception) = @_;
 288
 289         my $top = stack_pop($thread);
 290
 291         if ($exception) {
 292                 $top->{EXCEPTION} = $exception;
 293         }
 294         else {
 295                 $rest =~ /(\S+?) (\([^)]*\))?    (->(.*))?$/x or die "could not match finished log: $rest";
 296                 my ($name,$return) = ($1,$4);
 297
 298                 $name eq $top->{NAME} or die "warning: mismatched leave:\n"
 299                         ."\t(line $.) $name from\n"
 300                         ."\t(line ".$top->{LINE}.") ".$top->{NAME}."\n";
 301
 302                 $top->{RETURN} = defined($return) ? $return : 'void';
 303         }
 304
 305         --$ignore_level{$thread} if $ignore_level{$thread} > 0;
 306
 307         if ($ignore_level{$thread} == 0) {
 308                 write_xml_leave($thread,$top);
 309         }
 310 }
 311
 312 sub process_exception ( $$$ )
 313 {
 314         my ($thread,$exception,$rest) = @_;
 315         my ($name,$entry);
 316
 317         my $top = stack_top($thread);
 318
 319         if ($rest =~ /(\S+?) \([^)]*\)  \((0x[^)]+)\)/x) {
 320                 ($name,$entry) = ($1,$2);
 321         }
 322         elsif ($rest =~ /call_java_method/) {
 323                 $name = "call_java_method";
 324                 $entry = 0;
 325         }
 326         else {
 327                  die "could not match exception: $exception in $rest";
 328         }
 329
 330         $top->{ENTRYPOINT} = $entry unless defined($top->{ENTRYPOINT});
 331
 332         if ($name eq $top->{SHORTNAME} && $entry eq $top->{ENTRYPOINT}) {
 333                 if ($ignore_level{$thread} == 0) {
 334                         my $handled = '<exception name="'.$exception.'"/>'."\n";
 335                         write_xml($thread,$handled);
 336                 }
 337                 return; # exception handled locally
 338         }
 339
 340         # unwind a stack frame
 341
 342         while ($name ne 'call_java_method' && $name ne stack_slot($thread,-2)->{SHORTNAME}) {
 343                 stack_write($thread);
 344                 print STDERR "exception : $exception\n";
 345                 print STDERR "method    : $name\n";
 346                 print STDERR "entrypoint: $entry\n";
 347                 print STDERR "scope     : ".$top->{SHORTNAME}."\n";
 348                 print STDERR "scopeentry: ".$top->{ENTRYPOINT}."\n";
 349                 print STDERR "outer     : ".stack_slot($thread,-2)->{SHORTNAME}."\n";
 350                 print STDERR "outerentry: ".stack_slot($thread,-2)->{ENTRYPOINT}."\n";
 351                 print STDERR "unwinding stack...\n";
 352
 353                 warn "heuristic unwind: $exception in $rest";
 354                 process_leave($thread,$rest,$exception);
 355         }
 356
 357         process_leave($thread,$rest,$exception);
 358 }
 359
 360 sub process_call_log ( $$$ )
 361 {
 362         my ($thread,$keyword,$rest) = @_;
 363
 364         if ($keyword eq 'called' || $keyword eq '1st_call') {
 365                 process_call($thread,$keyword,$rest);
 366         }
 367         elsif ($keyword eq 'finished') {
 368                 process_leave($thread,$rest,undef);
 369         }
 370         else {
 371                 die "invalid log keyword: $keyword";
 372         }
 373 }
 374
 375 sub process_text ( $$ )
 376 {
 377         my ($thread,$text) = @_;
 378
 379         # print STDERR "$.: $text\n";
 380
 381         if ($opt_no_text_for_ignored && $ignore_level{$thread} > 0) {
 382                 return;
 383         }
 384
 385         my $top = stack_top($thread);
 386
 387         my $file = $files{$thread};
 388         print $file quote($text)."\n";
 389 }
 390
 391 # ======================================================================
 392 # MAIN PROGRAM
 393 # ======================================================================
 394
 395 sub main
 396 {
 397         eval {
 398                 my $lastthread;
 399                 while (<>) {
 400                         chomp($_);
 401                         if (/LOG: \[(\S+)\]\s+(.*)/) {
 402                                 my ($thread,$log) = ($1,$2);
 403                                 thread_register($thread);
 404                                 $lastthread = $thread;
 405                                 if ($log =~ /(1st_call|called|finished):\s*(.*)/) {
 406                                         process_call_log($thread,$1,$2);
 407                                 }
 408                                 elsif ($log =~ /Exception\s+(\S+)\s+thrown in\s+(.*)/) {
 409                                         process_exception($thread,$1,$2);
 410                                 }
 411                                 else {
 412                                         process_text($thread,$log);
 413                                 }
 414                         }
 415                         else {
 416                                 unless (defined($lastthread)) {
 417                                         $lastthread = '(nil)';
 418                                         thread_register($lastthread);
 419                                 }
 420                                 process_text($lastthread,$_);
 421                         }
 422                 }
 423         };
 424
 425         if ($@) {
 426             warn "error: $@";
 427             warn "warning: omitting the rest of the input";
 428         }
 429
 430         for my $thread (keys %stacks) {
 431                 my $ign = $ignore_level{$thread};
 432                 unless ($ign == 0) {
 433                     warn "warning: ignore_level not reset to 0 at end of input";
 434                     write_xml($thread,"\n<!-- LOG ENDS IN IGNORED METHOD - STACKTRACE: -->\n\n");
 435                     while ($ign > 0) {
 436                                 my $top = $stacks{$thread}->[-$ign];
 437                                 write_xml_frame($thread,$top);
 438                                 $ign--;
 439                     }
 440                 }
 441                 $files{$thread}->close();
 442         }
 443         print STDERR "processed $. lines\n";
 444 }
 445
 446 main();
 447
 448 # vim: noet ts=4 sw=4 ai
 449