KašpiPage

Selects useful infomation from scram output and colorizes it.

#! /usr/bin/perl -w

use Term::ANSIColor;
use IPC::Open3;

#----------------------------------------------------------------------------------------------------
# clear, reset, dark, bold, underline, underscore, blink, reverse, concealed, 
# black, white, red, green, blue, yellow, magenta, cyan,
# on_black, on_white, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan,
#----------------------------------------------------------------------------------------------------

sub srcscan
{
# Usage: srcscan($text, $normalColor)
#    $text -- the text to colorize
#    $normalColor -- The escape sequence to use for non-source text.

   my($line, $normalColor) = @_;

   my($srcon) = color("reset") . color("blue");
   my($srcoff) = color("reset") . $normalColor;

   $line = $normalColor . $line;

   # This substitute replaces `foo' with `AfooB' where A is the escape
   # sequence that turns on the the desired source color, and B is the
   # escape sequence that returns to $normalColor.
   $line =~ s/\`(.*?)\'/$srcon$1$srcoff/g;

   print($line, color("reset"));
}


sub MarkGCCOutput
{
	if (m/^(.*?):([0-9]+):(.*)$/) { # filename:lineno:message
		$field1 = $1 || "";
		$field2 = $2 || "";
		$field3 = $3 || "";
	
		# remove unuseful prefix in filename
		$field1 =~ s/\/afs\/domain.com.*?src\///;
		$field1 =~ s/\/home\/<username>.*?src\///;
	
		if ($field3 =~ m/\s+(W|w)arn(u|i)ng:.*/) {
			# Warning
			print($prefix, color("black"), "$field1:", color("reset"));
			print(color("green"), "$field2", color("reset"), "\n$prefix\t");
			srcscan($field3, color("magenta"));
			print("\n");
			return;
		}
		if ($field3 =~ m/\s+(E|e)rror:.*/) {
			# Error
			print($prefix, color("black"), "$field1:", color("reset"));
			print(color("green"), "$field2", color("reset"), "\n$prefix\t");
			srcscan($field3, color("red"));
			print("\n");
			return;
		}
		if ($field3 =~ m/\s+(N|n)ote:.*/) {
			# note (candidates are)
			#print($prefix, color("black"), "$field1:", color("reset"));
			#print(color("green"), "$field2", color("reset"), "\n$prefix\t");
			print("$prefix\t");
			srcscan($field3, color("cyan"));
			print("\n");
			return;
		}
		if ($field3 =~ m/.*:\s*(.*):\s*No such file or directory/) {
			print($prefix, color("black"), "$field1:", color("reset"));
			print(color("green"), "$field2", color("red"), "\n$prefix\tNo such a file or directory: ", color("reset"), $1, "\n");
			return;
		}
	} 

	if (m/^(.*?from )(.*?):([0-9]+)[:,]$/) {
		$text = $1;
		$file = $2;
		$line = $3;

		# remove unuseful prefix in filename
		$file =~ s/\/afs\/domain.com.*?src\///;
		$file =~ s/\/home\/<username>.*?src\///;

		print($prefix, $text, $file, ":", color("green"), $line, color("reset"), "\n");
		return;
	}

	if (m/^(.*?):\s*(In .+)`(.+)':$/) { # filename: In function `....':
		print($prefix, "\n", $prefix, color("black"), $2, color("blue"), $3, color("reset"), "\n");
		return;
	}

	if (m/^(.*?):(.+):$/) { # filename:message:
		$field1 = $1 || "";
		$field2 = $2 || "";
		
		# remove unuseful prefix in filename
		$field1 =~ s/\/afs\/domain.com.*?src\///;
		$field1 =~ s/\/home\/<username>.*?src\///;
		
		# No line number, treat as an "introductory" line of text.
		#print($colors{"introColor"}, "$field1:", color("reset"));
		print($prefix, "\n", $prefix, "");
		srcscan($field2, color("blue"));
		print("\n");
		return;
	}

	if (m/^: undefined reference to `(.*)'/) {
		print($prefix, color("red"), "undefined reference to ", color("blue"), $1, color("reset"), "\n");
		return;
	}

	if (m/^(.*)ld: cannot find (.*)$/) {
		print($prefix, color("red"), "ld: cannot find ", color("blue"), $2, color("reset"), "\n");
		return;
	}

	print($prefix, $_);
}

#----------------------------------------------------------------------------------------------------
#----------------------------------------------------------------------------------------------------

$scram_pid = open3('<&STDIN', \*SCRAMOUT, \*SCRAMOUT, 'scram', @ARGV);

$state = 'scram';
$margin = 0;
$prefix = '';

while(<SCRAMOUT>)
{
	# entering/leaving package
	if (m/(Entering) Package (.*)$/ || m/(Leaving) Package (.*)$/) {
		print(color("yellow"), $1, ' ', color("bold black"), $2, color("reset"), "\n");
		next;
	}

	# package built
	if (m/Package (.*?) built/) {
		#print('Package ', color("blue"), $1, color("reset"), ' built', "\n\n");
		next;
	}

	# compilation
	if (m/>> Compiling (.*)$/) {
		if ($margin == 1) { print("╙──────\n"); $margin = 0; }
      	$field1 = $1;
		$field1 =~ s/.*\///;
		print(color("yellow"), 'Compiling ', color("bold black"), $field1, color("reset"), "\n");
		$state = 'gcc';
		$prefix = '║ ';
		next;
	}

	if (m/>> Building shared library (.*)$/) {
		if ($margin == 1) { print("╙──────\n"); $margin = 0; }
		$field1 = $1;
		$field1 =~ s/.*\///;
		print(color("yellow"), 'Building ', color("bold black"), $field1, color("reset"), "\n");
		$state = 'library';
		next;
	}

	if (m/>> Building binary (.*)$/) {
		if ($margin == 1) { print("╙──────\n"); $margin = 0; }
		print(color("yellow"), 'Building ', color("bold black"), $1, color("reset"), "\n");
		$state = 'gcc';
		$prefix = '║ ';
		next;
	}
	
	if (m/Copying (.*?) to productstore area:/) {
		next;
	}

	if (m/@@@@ Running SealPluginRefresh/) {
		print(color("yellow"), 'Refreshing SealPlugin', color("reset"),"\n");
		next;
	}
	
	if (m/Note: Loading/) {
		next;
	}

	if (m/Checking shared library (.*)$/) {
		print(color("yellow"), "Checking $1 ", color("reset"));
		next;
	}

	if (m/ld: skipping incompatible/) {
		next;
	}

	if (m/@@@@ ----> OK/) {
		print(color("bold black"), 'OK', color("reset"), "\n");
		next;
	}

	if (m/@@@@ (.*)$/) {
		print("    ", $1, "\n");
		next;
	}

	if (m/Leaving library rule at (.*)$/) {
		$state = 'scram';
		next;
	}
	
	if (m/--- Updating SEAL plugin registration: (.*?) ---/) {
		next;
	}

	if (m/--- Registered EDM Plugin: (.*?)$/) {
		print(color("yellow"), "EDM Plugin ", color("bold black"), $1, color("reset"), "\n");
		next;
	}

	# output of gcc
	if ($state eq 'gcc') {
		if ($margin == 0) { print("$prefix\n"); $margin = 1; }
		&MarkGCCOutput($_);
		next;
	}

	# default behavior
	print($_);
}

if ($margin == 1 && $state eq 'gcc') { print("╙──────\n"); }

# Get the return code of the scram and exit with that.
waitpid($scram_pid, 0);
exit ($? >> 8);