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