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