#!/usr/bin/perl -w # $Id: tracemunch,v 1.6 2005/03/12 21:48:23 tom Exp $ ############################################################################## # Copyright (c) 1998-2002,2005 Free Software Foundation, Inc. # # # # Permission is hereby granted, free of charge, to any person obtaining a # # copy of this software and associated documentation files (the "Software"), # # to deal in the Software without restriction, including without limitation # # the rights to use, copy, modify, merge, publish, distribute, distribute # # with modifications, sublicense, and/or sell copies of the Software, and to # # permit persons to whom the Software is furnished to do so, subject to the # # following conditions: # # # # The above copyright notice and this permission notice shall be included in # # all copies or substantial portions of the Software. # # # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL # # THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING # # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # # DEALINGS IN THE SOFTWARE. # # # # Except as contained in this notice, the name(s) of the above copyright # # holders shall not be used in advertising or otherwise to promote the sale, # # use or other dealings in this Software without prior written # # authorization. # ############################################################################## # tracemunch -- compactify ncurses trace logs # # The error logs produced by ncurses with tracing enabled can be very tedious # to wade through. This script helps by compacting runs of log lines that # can be conveniently expressed as higher-level operations. use strict; our $putattr="PutAttrChar\\({{ '(.)' = 0[0-7]+ }}\\) at \\(([0-9]+), ([0-9]+)\\)"; our $waddnstr="waddnstr\\(0x([0-9a-f]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}"; our $win_nums=0; our $curscr=""; our $newscr=""; our $stdscr=""; our @win_addr; sub transaddr { my $n; my $arg = $_[0]; $arg =~ s/$curscr/curscr/g if ($curscr); $arg =~ s/$newscr/newscr/g if ($newscr); $arg =~ s/$stdscr/stdscr/g if ($stdscr); for $n (0..$#win_addr) { $arg =~ s/$win_addr[$n]/window$n/g if $win_addr[$n]; } return $arg; } while () { my $addr; my $n; my $awaiting; CLASSIFY: { # Transform window pointer addresses so it's easier to compare logs $awaiting = "curscr" if ($_ =~ /creating curscr/); $awaiting = "newscr" if ($_ =~ /creating newscr/); $awaiting = "stdscr" if ($_ =~ /creating stdscr/); if ($_ =~ /^create :window 0x([0-9a-f]+)/) { $addr = "0x$1"; if ($awaiting eq "curscr") { $curscr = $addr; } elsif ($awaiting eq "newscr") { $newscr = $addr; } elsif ($awaiting eq "stdscr") { $stdscr = $addr; } else { $win_addr[$win_nums] = $addr; $win_nums = $win_nums + 1; } $awaiting = ""; } elsif ($_ =~ /^\.\.\.deleted win=0x([0-9a-f]+)/) { $addr = "0x$1"; $_ = &transaddr($_); if ($addr eq $curscr) { $curscr = ""; } elsif ($addr eq $newscr) { $newscr = ""; } elsif ($addr eq $stdscr) { $stdscr = ""; } else { for $n (0..$#win_addr) { if ($win_addr[$n] eq $addr) { $win_addr[$n] = ""; } } } } # Compactify runs of PutAttrChar calls (TR_CHARPUT) if ($_ =~ /$putattr/) { my $putattr_chars = $1; my $starty = $2; my $startx = $3; while () { if ($_ =~ /$putattr/) { $putattr_chars .= $1; } else { last; } } print "RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n"; redo CLASSIFY; } # Compactify runs of waddnstr calls (TR_CALLS) if ($_ =~ /$waddnstr/) { my $waddnstr_chars = $2; my $winaddr = $1; while () { if ($_ =~ /$waddnstr/ && $1 eq $winaddr) { $waddnstr_chars .= $2; } else { last; } } my $winaddstr = &transaddr($winaddr); print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n"; redo CLASSIFY; } # More transformations can go here # Repeated runs of anything my $anyline = &transaddr($_); my $repeatcount = 1; while () { if (&transaddr($_) eq $anyline) { $repeatcount++; } else { last; } } if ($repeatcount > 1) { print "${repeatcount} REPEATS OF $anyline"; } else { print $anyline } redo CLASSIFY if $_; } # :CLASSIFY } # tracemunch ends here