The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

#!/home/utils/perl-5.8.8/bin/perl -w
use strict;
# $Id: makepplog,v 1.25 2008/05/17 14:08:37 pfeiffer Exp $
# 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 %s',
DEPEND => ' Targets %s depend on %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',
LOAD => 'Loading makefile %s with default directory %s',
LOAD_AGAIN => 'Reloading makefile %s (because of %s) with default directory %s',
LOAD_AUTOMAKE => 'Cleaning automake junk out of %S',
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',
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',
PREBUILD => 'Pre-building %s from %s',
REMOVE => 'Removing target %s before running its rule',
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_ALT => 'Alternate rules (%s and %s) for target %s',
RULE_DISCARD_MAKE => ' Rule %s discarded because it invokes $(MAKE)',
RULE_FAILED => '*** This failed from rule %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_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 $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_RULE => 'Scanning rule for %s because %s',
SCAN_UNCACHEABLE => 'Not caching scan info for %s because the scanner for %s doesn\'t support it',
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',
);
# This list contains a hashref for every logging version, which is the list
# index. Logging versions must be incremented in makepp's ::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;
$obsolete_msg[0] =
{
INCL => 'Including %s',
INCL_BY => '%s included by %s'
};
$obsolete_msg[1] =
{
N_FILES => '%d files updated and %d targets failed'
};
our $VERSION = '@VERSION@';
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 makepp" even if
# . is not in his path.
if( -f "$_/Glob.pm" ) { # Found something we need?
$datadir = $_;
last;
}
}
}
$datadir or die "makepp: can't find library files\n";
$datadir = eval "use Cwd; cwd . '/$datadir'"
if $datadir =~ /^\./; # Make it absolute, if it's a relative path.
#@@
unshift @INC, $datadir;
}
use Utils;
use TextSubs ();
my( $cwd, $instdir, $keylist, $noindent, $rename, $tabulate, $uniq );
my( @logfiles, $outfile );
my $follow = 0;
my $prefix = '';
my $showkey = '';
{
my $tmp;
TextSubs::getopts
['c', qr/current[-_]?working[-_]?dir(?:ectory)/, \$cwd, 0, 0],
['C', qr/current[-_]?working[-_]?dir(?:ectory)[-_]?and[-_]?up/, \$cwd, 1],
[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],
[qr/[h?]/, 'help', undef, 0, \&usage];
}
$| = 1 if $follow > 1;
sub usage { print << 'END_OF_USAGE'; exit 0 }
Usage: makepplog [-options]
Render and optionally filter what makepp logged about the last build.
-c, --current-working-dir or --current-working-directory
Make all files under current dir, be relative to it.
-C N, --current-working-dir-and-up=N or --current-working-directory-and-up=N
Make all files under current N dirs up, be relative to this one.
-i, --install-dir or --installation-directory
Replace path to makepp internal files with ...
-k LIST, --keys=LIST or --keylist=LIST
Show only messages with, !without or ^without keys, {bash,patterns}.
-K or --showkey
Prepend every message with its internal key (to see what to select)
-l FILE, --log=FILE or --logfile=FILE
Alternate file or dir to get log from, can be given more than once.
-n or --no-indent
Don't show scanner nesting with indentation.
-o FILE or --output=FILE
Redirect output.
-p or --prefix
Prefix every line with makepplog:
-t or --tabulate
Put each list item on a new line.
-u, --uniq or --unique
Don't repeat lines about inclusion or scanning.
Look at @htmldir@/makepplog.html for more details,
or at http://makepp.sourceforge.net/@BASEVERSION@/makepplog.html
or type "man makepplog".
END_OF_USAGE
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 = FileInfo::file_info $_;
FileInfo::dereference $finfo;
$_ = FileInfo::absolute_filename $finfo;
Rewrite::cwd $cwd if defined $cwd;
$ret .= $_;
}
$ret;
}e;
}
}
if( $instdir && defined $cwd ) {
$rename = sub { Rewrite::cwd $cwd || &instdir };
} elsif( defined $cwd ) {
$rename = sub { Rewrite::cwd $cwd };
} elsif( $instdir ) {
$rename = \&instdir;
}
find_logfiles @logfiles;
open STDOUT, '>', $outfile if $outfile;
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} = () if !%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)!...!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}/$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) . "'";
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}'";
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;
}
}