contrib/log2xml.pl

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