#!/usr/bin/env perl
# $Id: tracemunch,v 1.26 2019/12/21 22:33:35 tom Exp $
##############################################################################
# Copyright (c) 1998-2018,2019 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;
use warnings;

our $putattr =
    'PutAttrChar\(\{\{ ' . "'(.)'"
  . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
our $waddnstr =
  'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}';

# If the trace is complete, we can infer addresses using the return value from
# newwin, etc.  But if it is incomplete, we can still check for special cases
# such as SCREEN* and WINDOW* parameters.  In this table, the type for the
# first parameter is encoded, relying upon an ncurses programming convention:
# 1 = SCREEN*
# 2 = WINDOW*
# 4 = TERMINAL*
our %known_p1 = qw(
  TransformLine           1
  _nc_freewin             2
  _nc_initscr             1
  _nc_makenew             1
  _nc_mingw_console_read  1
  _nc_reset_colors        1
  _nc_scroll_optimize     1
  _nc_tinfo               1
  _nc_tinfo_mvcur         1
  _nc_wgetch              2
  adjust_window           2
  assume_default_colors   1
  attr_get                2
  baudrate                1
  beep                    1
  border_set              2
  box                     2
  box_set                 2
  can_change_color        1
  cbreak                  1
  clearok                 2
  color_content           1
  copywin                 2
  curs_set                1
  decrease_size           1
  def_prog_mode           1
  def_shell_mode          1
  define_key              1
  del_curterm             1
  delay_output            1
  delscreen               1
  delwin                  2
  derwin                  2
  doupdate                1
  dupwin                  2
  echo                    1
  endwin                  1
  erasechar               1
  filter                  1
  flash                   1
  flushinp                1
  getattrs                2
  getbegx                 2
  getbegy                 2
  getbkgd                 2
  getcurx                 2
  getcury                 2
  getmaxx                 2
  getmaxy                 2
  getmouse                1
  getparx                 2
  getpary                 2
  halfdelay               1
  has_ic                  1
  has_il                  1
  has_key                 1
  idcok                   2
  idlok                   2
  immedok                 2
  increase_size           1
  init_color              1
  init_pair               1
  intrflush               1
  is_cleared              2
  is_idcok                2
  is_idlok                2
  is_immedok              2
  is_keypad               2
  is_leaveok              2
  is_linetouched          2
  is_nodelay              2
  is_notimeout            2
  is_pad                  2
  is_scrollok             2
  is_subwin               2
  is_syncok               2
  is_term_resized         1
  is_wintouched           2
  key_defined             1
  keybound                1
  keyok                   1
  keypad                  2
  killchar                1
  leaveok                 2
  longname                1
  meta                    2
  mouseinterval           1
  mousemask               1
  mvcur                   1
  mvderwin                2
  mvwadd_wch              2
  mvwadd_wchnstr          2
  mvwadd_wchstr           2
  mvwaddch                2
  mvwaddchnstr            2
  mvwaddchstr             2
  mvwaddnstr              2
  mvwaddnwstr             2
  mvwaddstr               2
  mvwaddwstr              2
  mvwchgat                2
  mvwdelch                2
  mvwget_wch              2
  mvwget_wstr             2
  mvwgetch                2
  mvwgetn_wstr            2
  mvwgetnstr              2
  mvwgetstr               2
  mvwhline                2
  mvwhline_set            2
  mvwin                   2
  mvwin_wch               2
  mvwin_wchnstr           2
  mvwin_wchstr            2
  mvwinch                 2
  mvwinchnstr             2
  mvwinchstr              2
  mvwins_nwstr            2
  mvwins_wch              2
  mvwins_wstr             2
  mvwinsch                2
  mvwinsnstr              2
  mvwinsstr               2
  mvwinstr                2
  mvwinwstr               2
  mvwvline                2
  mvwvline_set            2
  newpad                  1
  newterm                 1
  newwin                  1
  nl                      1
  nocbreak                1
  nodelay                 2
  noecho                  1
  nofilter                1
  nonl                    1
  noqiflush               1
  noraw                   1
  notimeout               2
  overlap                 2
  overlay                 2
  overwrite               2
  pair_content            1
  pecho_wchar             2
  pechochar               2
  pnoutrefresh            2
  putwin                  2
  qiflush                 1
  raw                     1
  redrawwin               2
  reset_prog_mode         1
  reset_shell_mode        1
  resetty                 1
  resize_term             1
  resizeterm              1
  restartterm             1
  ripoffline              1
  savetty                 1
  scr_init                1
  scr_restore             1
  scr_set                 1
  scroll                  2
  scrollok                2
  set_curterm             4
  set_term                1
  slk_attr                1
  slk_attr_set            1
  slk_attroff             1
  slk_attron              1
  slk_attrset             1
  slk_clear               1
  slk_color               1
  slk_init                1
  slk_label               1
  slk_noutrefresh         1
  slk_refresh             1
  slk_restore             1
  slk_set                 1
  slk_touch               1
  start_color             1
  subwin                  2
  syncok                  2
  termattrs               1
  termname                1
  tgetflag                1
  tgetnum                 1
  tigetflag               1
  tigetnum                1
  tigetstr                1
  tinfo                   1
  touchline               2
  touchwin                2
  typeahead               1
  unget_wch               1
  ungetch                 1
  ungetmouse              1
  untouchwin              2
  use_default_colors      1
  use_env                 1
  use_legacy_coding       1
  use_screen              1
  use_tioctl              1
  use_window              2
  vidattr                 1
  vidputs                 1
  vw_printw               2
  vwprintw                2
  wadd_wch                2
  wadd_wchnstr            2
  wadd_wchstr             2
  waddch                  2
  waddchnstr              2
  waddchstr               2
  waddnstr                2
  waddnwstr               2
  waddstr                 2
  waddwstr                2
  wattr_get               2
  wattr_off               2
  wattr_on                2
  wattr_set               2
  wattroff                2
  wattron                 2
  wattrset                2
  wbkgd                   2
  wbkgdset                2
  wborder                 2
  wborder_set             2
  wchgat                  2
  wclear                  2
  wclrtobot               2
  wclrtoeol               2
  wcolor_set              2
  wcursyncup              2
  wdelch                  2
  wdeleteln               2
  wechochar               2
  wenclose                2
  werase                  2
  wget_wch                2
  wget_wstr               2
  wgetbkgrnd              2
  wgetch                  2
  wgetch_events           2
  wgetdelay               2
  wgetn_wstr              2
  wgetnstr                2
  wgetparent              2
  wgetscrreg              2
  wgetstr                 2
  whline                  2
  whline_set              2
  win_wch                 2
  win_wchnstr             2
  win_wchstr              2
  winch                   2
  winchnstr               2
  winchstr                2
  winnstr                 2
  winnwstr                2
  wins_nwstr              2
  wins_wch                2
  wins_wstr               2
  winsch                  2
  winsdelln               2
  winsertln               2
  winsnstr                2
  winsstr                 2
  winstr                  2
  winwstr                 2
  wmouse_trafo            2
  wmove                   2
  wnoutrefresh            2
  wprintw                 2
  wredrawln               2
  wrefresh                2
  wresize                 2
  wscrl                   2
  wsetscrreg              2
  wstandend               2
  wstandout               2
  wsyncdown               2
  wsyncup                 2
  wtimeout                2
  wtouchln                2
  wvline                  2
);

our $scr_nums = 0;
our $thr_nums = 0;
our $trm_nums = 0;
our $try_nums = 0;
our $win_nums = 0;
our $curscr   = "";
our $newscr   = "";
our $stdscr   = "";
our %scr_addr;
our %thr_addr;
our %trm_addr;
our %try_addr;
our %win_addr;

sub has_addr($) {
    my $value  = shift;
    my $result = 0;
    $result = 1 if ( $value =~ /\b0x[[:xdigit:]]+\b/i );
    return $result;
}

sub transaddr($) {
    my $arg = shift;
    my $n;

    $arg =~ s/\b$curscr\b/curscr/g if ($curscr);
    $arg =~ s/\b$newscr\b/newscr/g if ($newscr);
    $arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
    if ( &has_addr($arg) ) {
        foreach my $addr ( keys %scr_addr ) {
            $n = $scr_addr{$addr};
            $arg =~ s/\b$addr\b/screen$n/g if ( defined $n );
        }
    }
    if ( &has_addr($arg) ) {
        foreach my $addr ( keys %thr_addr ) {
            $n = $thr_addr{$addr};
            $arg =~ s/\b$addr\b/thread$n/g if ( defined $n );
        }
    }
    if ( &has_addr($arg) ) {
        foreach my $addr ( keys %trm_addr ) {
            $n = $trm_addr{$addr};
            $arg =~ s/\b$addr\b/terminal$n/g if ( defined $n );
        }
    }
    if ( &has_addr($arg) ) {
        foreach my $addr ( keys %try_addr ) {
            $n = $try_addr{$addr};
            $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
        }
    }
    if ( &has_addr($arg) ) {
        foreach my $addr ( keys %win_addr ) {
            $n = $win_addr{$addr};
            $arg =~ s/\b$addr\b/window$n/g if ( defined $n );
        }
    }
    if ( &has_addr($arg) ) {
        if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) {
            $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i;
        }
        elsif (
            $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i )
        {
            $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i;
        }
        elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i )
        {
            $arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i;
        }
    }
    if ( &has_addr($arg) and $arg =~ /called\s+\{/ ) {
        my $func = $arg;
        chomp $func;
        $func =~ s/^.*called\s+\{([[:alnum:]_]+)\(.*$/$1/;
        if ( defined $known_p1{$func} ) {
            my $addr = $arg;
            my $type = $known_p1{$func};
            chomp $addr;
            $addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
            if ( $type == 1 ) {
                $scr_addr{$addr} = ++$scr_nums;
                $arg = &transaddr($arg);
            }
            elsif ( $type == 2 ) {
                $win_addr{$addr} = ++$win_nums;
                $arg = &transaddr($arg);
            }
            elsif ( $type == 4 ) {
                $trm_addr{$addr} = ++$trm_nums;
                $arg = &transaddr($arg);
            }
        }
    }

    return $arg;
}

sub muncher($) {
    my $STDIN = shift;

    while (<$STDIN>) {
        my $addr;
        my $n;
        my $awaiting = "";

      CLASSIFY: {

            # just in case someone tries a file with cr/lf line-endings:
            $_ =~ s/\r\n/\n/g;
            $_ =~ s/\r/\n/g;

            my $thread = "";
            if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
                $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
                $thread = "thread" . $thr_addr{$1} . ":";
                $_ =~ s/^[^:]*://;
            }

            # 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/ );
            $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
            if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
                $addr = "0x$1";
                if ( $awaiting eq "curscr" ) {
                    $curscr = $addr;
                }
                elsif ( $awaiting eq "newscr" ) {
                    $newscr = $addr;
                }
                elsif ( $awaiting eq "stdscr" ) {
                    $stdscr = $addr;
                }
                else {
                    $win_addr{$addr} = $win_nums++;
                }
                $awaiting = "";
            }
            elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
                $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
            }
            elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
            {
                $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
            }
            elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
                $addr = "0x$2";
                $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
                $awaiting = "";
            }
            elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
                $addr = "0x$2";
                if ( $awaiting eq "screen" ) {
                    $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
                }
            }
            elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
                $addr = "0x$1";
                $_    = &transaddr($_);
                if ( $addr eq $curscr ) {
                    $curscr = "";
                }
                elsif ( $addr eq $newscr ) {
                    $newscr = "";
                }
                elsif ( $addr eq $stdscr ) {
                    $stdscr = "";
                }
                else {
                    undef $win_addr{$addr};
                }
            }

            # Compactify runs of PutAttrChar calls (TR_CHARPUT)
            if ( $_ =~ /$putattr/ ) {
                my $putattr_chars = $1;
                my $starty        = $2;
                my $startx        = $3;
                while (<$STDIN>) {
                    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 (<$STDIN>) {
                    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 (<$STDIN>) {
                if ( &transaddr($_) eq $anyline ) {
                    $repeatcount++;
                }
                else {
                    last;
                }
            }
            if ( $repeatcount > 1 ) {
                print "${repeatcount} REPEATS OF $anyline";
            }
            else {
                print $thread . $anyline;
            }
            redo CLASSIFY if $_;

        }    # :CLASSIFY
    }
}

if ( $#ARGV >= 0 ) {
    while ( $#ARGV >= 0 ) {
        my $file = shift @ARGV;
        open my $ifh, "<", $file or die $!;
        &muncher($ifh);
    }
}
else {
    &muncher( \*STDIN );
}

# tracemunch ends here