makepplog

#!/usr/bin/env perl
# $Id: makepplog,v 1.59 2017/08/06 21:19:08 pfeiffer Exp $

package Mpp;

use strict;

# Shall we put a period after each message?  Or once for all before the \n when printing?
my %log_msg =
 (
  AUTOLOAD => 'Autoloading for target %s',

  BC_COPY => 'Copied %s from build cache file %s',
  BC_EXPORT => 'Target %s exported to build cache file %s',
  BC_FOUND => 'Found match for %s in build cache with key %s',
  BC_LINK => 'Target %s hard-linked into build cache file %s and write-protected',
  BC_NONE => 'No entry for %s in build cache with key %s',
  BC_NO_KEY => 'Not checking build cache for %s because it has no key',

  BUILD_ARCH => 'Rebuild %s because last build was on %s and this is on %s',
  BUILD_CHANGED => 'Rebuild %s because %s changed',
  BUILD_CMD => 'Rebuild %s because last build command (%s) differs from current command (%s)',
  BUILD_DEP_ADD => 'Rebuild %s because of added dependencies %s',
  BUILD_DEP_DEL => 'Rebuild %s because of removed dependencies %s',
  BUILD_ENV => 'Rebuild %s because value of environment variable %s (%s) differs from previous value (%s)',
  BUILD_ENV_ADD => 'Rebuild %s because environmental dependency on %s is new',
  BUILD_ENV_DEL => 'Rebuild %s because environmental dependency on %s no longer exists',
  BUILD_FINAL => 'Rebuild %s because --final-rule-only specified',
  BUILD_INVALID => 'Rebuild %s because build info got invalidated',
  BUILD_MARK_NEW => 'Rebuild %s because %s is marked new',
  BUILD_NONE => 'Build %s because it doesn\'t exist',
  BUILD_NOT => 'Not building %s because it\'s marked for dont-build',
  BUILD_OLD => 'Rebuild %s because it\'s older than %s',
  BUILD_PHONY => 'Rebuild %s because it is a phony target',
  BUILD_RECURSIVE => 'Rebuild %s because command is recursive invocation of make',

  CACHED_DEP => 'Building %s as a cached scanned dependency of %s',

  DEL_STALE => 'Removing stale generated file or symlink %s',
  DEBUG => 'Environment var $MAKEPP_DEBUG is %s (1 means extra verbose)',
  DEPEND => ' Targets %s depend on %s',

  ERROR => '%s has non-fatal error %s, %s',
  EXPR => 'Expression %s returns value %s at %s',

  IFEQ => 'if(n)eq comparing %s with %s at %s',
  INCL => '%s includes %s',
  INCL_WHO => 'something includes %s',
  INFER_DEP => 'infer_objects adding %s to dependency list because of %s',
  INFER_SEED => 'infer_objects called with seed objects %s',

  LEX_REDIRECT => 'Lexical analysis of I/O redirect failed for rule %s',
  LEX_RULE => 'Lexically analyzing rule for %s because %s',
  LOAD => 'Loading makefile %s with default directory %s',
  LOAD_AGAIN => 'Reloading makefile %s (because of %s) with default directory %s',
  LOAD_AUTOMAKE => 'Internally rewriting %s to fix Automake junk (see with --dump-makefile)',
  LOAD_CMAKE => 'Internally rewriting %s to fix CMake recursion (see with --dump-makefile)',
  LOAD_DEFAULT => 'Loading default makefile for directory %s',
  LOAD_END => 'Finished loading %s',
  LOAD_INCL => 'Including %s from %s',
  LOAD_REC => 'Makefile %s seems recursive, so makefiles for its dependencies will not be implicitly loaded',
  LOG => 'Recursive make at %s will log to %s in its destination directory',

  MAYBE_STALE => 'Ignoring possibly stale generated file %s',

  NOT_FOUND => '%s not found in $PATH at %s',
  NOT_IN_SANDBOX => 'Not updating build info for %s because it\'s not in my sandbox',
  N_CACHE_HITS => '%d files imported from build cache',
  N_FILES => '%d files updated, %d phony targets built and %d targets failed',
  N_REP_HITS => '%d files imported from repositories',

  OUT_OF_DATE => 'Discarding out-of-date or corrupt build info file %s',

  PARSE => 'Parsing command %s from directory %s for rule %s',
  PARSE_NONE => 'Parser none for %s for rule %s',
  PARSE_SHELL => 'Parser shell %s command %s for rule %s',
  PARSE_SKIP_WORD => 'Parser skip_word from %s to %s for rule %s',
  PREBUILD => 'Pre-building %s from %s',
  REMOVE => 'Removing target %s before running its rule, because %s',

  REP_CHECK => 'Check repository file %s',
  REP_EXISTING => '... using existing symbolic link',
  REP_LINK => 'Linking %s from repository file %s',
  REP_LOAD => 'Loading repository %s for %s',
  REP_MANIFEST => ' Repository using %s',
  REP_OUTDATED => 'Removing outdated repository link %s',
  REP_SKIP => 'Skipping generated repository file %s',

  RULE_ALL => 'Attempt to recover a rule for all files in %s',
  RULE_ALT => 'Alternate rules (%s and %s) for target %s',
  RULE_DISCARD_MAKE => ' Rule %s discarded because it invokes $(MAKE)',
  RULE_EXTEND => 'Add target %s to rule for %s',
  RULE_FAILED => '*** This failed from rule %s',
  RULE_GROK => '%s rule at %s outputs %s inputs %s actions %s',
  RULE_IGN_MAKE => ' Rule %s ignored because it invokes $(MAKE)',
  RULE_IGN_PATTERN => ' Rule %s ignored because it is a pattern rule',
  RULE_NEARER => ' Rule %s chosen because it is from a nearer makefile',
  RULE_NEARER_KEPT => ' Rule %s kept because it is from a nearer makefile',
  RULE_NEW => 'Recover rule for %s from previous build info',
  RULE_SET => 'Rule to build %s from %s at %s',
  RULE_SHORTER => ' Rule %s chosen because it has a shorter chain of inference',

  SCAN => 'Scanning %s',
  SCAN_CACHED => 'Using cached scanner info for %s',
  SCAN_C_NOT => 'Not scanning %s due to $Mpp::Scanner::C::dont_scan_hook',
  SCAN_INFO => ' Trying to retrieve scan info for %s',
  SCAN_INFO_FROM => 'Using %s to retrieve scan info',
  SCAN_INFO_NOT => 'Couldn\'t use %s to retrieve scan info because %s',
  SCAN_NOT_SYS => 'Not scanning system file %s',
  SCAN_NOT_UNWRITABLE => 'Not scanning unwritable file %s',
  SCAN_UNCACHEABLE => 'Not caching scan info for %s because the parser for %s doesn\'t support it',
  SHELL => 'Shell command %s at %s',
  SYMLINK => 'After building, %s is a symbolic link',
  SYMLINK_KEEP => 'Keeping symbolic link %s from previous build at %s',
  SUCCESS => '%s successfully executed for %s',

  TRY => 'Trying to build %s',

  UP_TO_DATE => '%s is up to date',
  USE => ' Using rule %s',
  USE_FAIL => 'Module %s not found',

  VAR => 'Variable %s returns value %s at %s',
  VAR_EXPAND => 'Variable %s expands value %s at %s',

  VERSION => 'Running %s with Perl %s on %s',
 );

# This list contains a hashref for every logging version, which is the list
# index.  Logging versions must be incremented in makepp's Mpp::log function
# every time one or more symbol's meaning changes incompatibly.  Removing a
# symbol, e.g. when renaming it, only requires moving the element from
# %log_msg to $obsolete_msg[<current log version>].  But if a change to the
# same symbol (other than a superficial formulation change) occurs, the old
# text must be copied from %log_msg to $obsolete_msg[<log version before
# incrementing>], before changing it above.
my @obsolete_msg =
  ({				# V0
    INCL => 'Including %s',
    INCL_BY => '%s included by %s'
   },
   {				# V1
    N_FILES => '%d files updated and %d targets failed',

    SCAN_RULE => 'Scanning rule for %s because %s'
   },
   {				# V2
    REMOVE => 'Removing target %s before running its rule'
   });



our $datadir;
BEGIN {
#@@setdatadir
#
# Find the location of our data directory that contains the auxiliary files.
# This is normally built into the program by install.pl, but if makepp hasn't
# been installed, then we look in the directory we were run from.
#
  $datadir = $0;		# Assume it's running from the same place that
				# we're running from.
  unless( $datadir =~ s@/[^/]+$@@ ) { # No path specified?
				# See if we can find ourselves in the path.
    foreach( split( /:/, $ENV{'PATH'} ), '.' ) {
				# Add '.' to the path in case the user is
				# running it with "perl makepplog" even if
				# . is not in his path.
      if( -d "$_/Mpp" ) {	# Found something we need?
	$datadir = $_;
	last;
      }
    }
  }
  $datadir or die "makepplog: can't find library files\n";

  $datadir = eval "use Cwd; cwd . '/$datadir'"
    if $datadir =~ /^\./;	# Make it absolute, if it's a relative path.
  do "$datadir/Mpp/DB.pm" if exists $DB::{sh};
#@@
  unshift @INC, $datadir;
}

use Mpp::Utils;
use Mpp::File;
use Mpp::Text ();

my( $cwd, $instdir, $keylist, $noindent, $rename, $tabulate, $uniq, $tmp );
my( @logfiles, $outfile );
my $follow = 0;
my $prefix = '';
my $showkey = '';

{
  my $tmp;
  Mpp::Text::getopts
    ['c', qr/current[-_]?working[-_]?dir(?:ectory)/, \$cwd, 0, 0],
    ['C', qr/current[-_]?working[-_]?dir(?:ectory)[-_]?and[-_]?up/, \$cwd, 1],
    ['d', qr/set[-_]?dir(?:ectory)/, \$tmp, 1, sub {
       $CWD_INFO = file_info $tmp;
       $cwd ||= 0;
     }],
    [qw(f follow), \$follow],
    ['i', qr/install(?:ation)?[-_]?dir(?:s|ectory|ectories)/, \$instdir],
    ['k', qr/key(?:s|list)/, \$keylist, 1],
    [qw(K showkey), \$showkey],
    ['l', qr/log(?:[-_]?file)?/, \$tmp, 1, sub { push @logfiles, $tmp }],
    ['n', qr/no[-_]?indent/, \$noindent],
    [qw(o output), \$outfile, 1],
    [qw(p prefix), \$prefix, 0, 'makepplog: '],
    [qw(t tabulate), \$tabulate],
    ['u', qr/uniq(?:ue)?/, \$uniq],

    splice @Mpp::Text::common_opts;
}

$| = 1 if $follow > 1;


my %instdir;
sub instdir {
  if( s!^((?:[a-z]:)?/.+)(?=/makepp_(?:builtin_rules|default_makefile)\.mk(:|$))!...! && $2 ) {
    my $instdir = $1;
    s<(:\d+\()((/?)[^\)]*)> {
      my $ret = $1;
      for( $3 ? "$2" : "$instdir/$2" ) {
	my $finfo = file_info $_;
	dereference $finfo;
	$_ = absolute_filename $finfo;
	Mpp::Rewrite::cwd $cwd if defined $cwd;
	$ret .= $_;
      }
      $ret;
    }e;
  }
}

if( $instdir && defined $cwd ) {
  $rename = sub { Mpp::Rewrite::cwd $cwd || &instdir };
} elsif( defined $cwd ) {
  $rename = sub { Mpp::Rewrite::cwd $cwd };
} elsif( $instdir ) {
  $rename = \&instdir;
}

find_logfiles @logfiles;
open STDOUT, '>', $outfile if $outfile;

if( defined $cwd and defined $keylist ? $keylist !~ /^!-c/ : 1 ) {
  my $dir = $CWD_INFO;
  printf "${prefix}Replacing `%s' by `.'\n", absolute_filename $dir;
  for my $n ( 1..$cwd) {
    $dir = $dir->{'..'};
    printf "${prefix}Replacing `%s' by `%s'\n", absolute_filename( $dir ),
      join '/', ('..') x $n;
  }
}

my %want;
my( %incl, %cached_dep, %scan ); # Redundant message counters for --uniq
my $warned_corrupt;
FILE:
for my $logfile ( @logfiles ) {
  open my $log, '<', $logfile or die "$0: can't open `$_'--$!\n";

  $_ = <$log>;
  s/^(\d+)\01//;		# Strip log version.
  my $log_version = $1 || 0;	# Anything obsoleted since that version may
				# then have been in use.  print;
  if( @obsolete_msg ) {		# 1st file
    for my $version ( $log_version..$#obsolete_msg ) {
      $log_msg{$_} = $obsolete_msg[$version]{$_} for keys %{$obsolete_msg[$version]};
    }
    @obsolete_msg = ();

    for( $keylist ) {
      last if !defined;
      tr/a-z/A-Z/;
      s/(?=[?*])/./g;
      if( s/\{/(?:/g ) {
	tr/,}/|)/ or die "makepplog: error: -k, --keylist contained '{', but no ',' or '}'\n";
      } else {
	/,/ and die "makepplog: error: -k, --keylist contained ',', but no '{...}'\n";
      }
      for my $re ( split ) {
	if( $re =~ s/^[!^]// ) {
	  @want{keys %log_msg} = () unless %want;
	  delete @want{grep /^$re$/, keys %want};
	} else {
	  @want{grep /^$re$/, keys %log_msg} = ();
	}
      }
    }

    @want{keys %log_msg} = () if !%want;
  }
  s!^'?(?:[a-z]:)?/.+(/makepp)\b'?!...\l$1!i if $instdir;
  print;

  my $indent = '';
  my( %dir_name, %file_name, $incl, @incl, $cached_dep, @cached_dep );
 RETRY:
  while( <$log> ) {

    if( $noindent ) {
      s/^[\02\03]//s;
    } elsif( s/^\03//s ) {
      $indent .= '  ';
    } elsif( s/^\02//s ) {
      substr $indent, -2, 2, '';
    }

    if( /\01/ ) {		# A key/finfos line?
      until( /\01\r?\n/m ) {
	if( defined( my $more = <$log> )) {
	  s/\n\Z/\\n/;
	  $_ .= $more;
	} elsif( $follow ) {
	  sleep 1;
	} else {
	  die "makepplog: error: record is incomplete, use -f, --follow while makepp runs\n";
	}
      }
      # Extract the name definitions
      while( s/([\da-f]+)\03([^\01-\03]+)(?:\03([^\01-\03]+)(?:\03([^\01-\03]*))?)?/$1/ ) {
	#my( $key, $name, $dirkey, $dirname ) = ( $1, $2, $3, $4 ) -- expensive copy op
	if( defined $3 ) {	# With dirname
	  if( defined $4 ) {	# Dirname not yet known
	    $dir_name{$3} = $4; # Save orig for concatenating
	    for( "$4" ) {
	      &$rename() if $rename;
	      $file_name{$3} = $_;
	    }
	  }
	  unless(defined $dir_name{$3}) {
	      $dir_name{$3} = '???';
	      warn "Corrupt log file (probably because of concurrent write access to $logfile)" unless $warned_corrupt++;
	  }
	  for( $dir_name{$3} eq '/' ? "/$2" : "$dir_name{$3}/$2" ) {
	    $dir_name{$1} = $_;	# Might be a dir.
	    &$rename() if $rename;
	    $file_name{$1} = $_;
	  }
	} else {
	  for( "$2" ) {
	    &$rename() if $rename;
	    $file_name{$1} = $_;
	  }
	}
      }

      my( $key, @args ) = split /\01/;
      pop @args;		# Remove the newline we kept to work around
				# the stupid end handling of split.
      if( exists $want{$key} ) {
	next if $uniq && $key =~ /^SCAN/ && $scan{$key}{$file_name{$args[0]}}++;

	if( $log_version && $key eq 'INCL' ) {
	  # Merge adjacent INCL statements, which is currently hard to do in makepp.
	  next
	    if $uniq && $incl{$file_name{$args[0]}}{$file_name{$args[1]}}++;
	  if( !defined $incl ) {
	  INCL:
	    ($incl, @incl) = @args;
	    next;
	  } elsif( $incl eq $args[0] ) {
	    push @incl, $args[1];
	    next;
	  }
	}
	if( defined $incl ) {
	  # If we get here the previous message was INCL, and this one is not, or is, but for a different file.
	  $showkey &&= 'INCL ';
	  printf "$prefix$showkey$indent$log_msg{INCL}\n",
	    "`$file_name{$incl}'",
	    '`' . (join $tabulate ? "',\n$prefix$showkey$indent  `" : "', `", map $file_name{$_}, @incl) . "'";
	  no warnings 'deprecated';    # TODO: replace the goto
	  goto INCL if $key eq 'INCL'; # Next one follows right behind.
	  undef $incl;
	}

	if( $key eq 'CACHED_DEP' ) {
	  # Merge adjacent CACHED_DEP statements, which is currently hard to do in makepp.
	  next
	    if $uniq && $cached_dep{$file_name{$args[1]}}{$file_name{$args[0]}}++;
	  if( !defined $cached_dep ) {
	  CACHED_DEP:
	    ($cached_dep[0], $cached_dep) = @args;
	    next;
	  } elsif( $cached_dep eq $args[1] ) {
	    push @cached_dep, $args[0];
	    next;
	  }
	}

	if( defined $cached_dep ) {
	  # If we get here the previous message was CACHED_DEP, and this one is not, or is, but for a different file.
	  $showkey &&= 'CACHED_DEP ';
	  printf "$prefix$showkey$indent$log_msg{CACHED_DEP}\n",
	    '`' . (join $tabulate ? "',\n$prefix$showkey$indent  `" : "', `", map $file_name{$_}, @cached_dep) . "'",
	    "`$file_name{$cached_dep}'";
	  no warnings 'deprecated'; goto CACHED_DEP if $key eq 'CACHED_DEP'; # Next one follows right behind.
	  undef $cached_dep;
	  @cached_dep = ();
	}

	# Output the actual message.
	$showkey &&= "$key ";
	printf "$prefix$showkey$indent$log_msg{$key}\n",
	  $key =~ /^N_/ ?
	    @args :
	    map {
	      $_ eq '' ? '' :
		'`' .
		(join $tabulate ? "',\n$prefix$showkey$indent  `" : "', `",
		 map exists $file_name{$_} ? $file_name{$_} : do { &$rename() if $rename; $_ }, split /\02/) .
		"'";
	    } @args;
      } elsif( !exists $log_msg{$key} ) {
	print "$indent$_"; # In case a non structured line somehow contained ^A.
      }
      next FILE if $follow && $key eq 'N_FILES';
    } else {
      print "$indent$_";
    }
  }
  if( $follow ) {
    sleep 1;
    goto RETRY;
  }
}

__DATA__
[option ...]

Render and optionally filter what makepp logged about the last build.
Valid options are: