source: branches/properties/SOURCE_TOOLS/short_error_summary.pl

#!/usr/bin/perl

use strict;
use warnings;

my $DEBUG = 0;

my $DISPLAYED_LINES = 40; # how much to display as default
{
  my $DARWIN = $ENV{DARWIN}; die "expected environment variable DARWIN to be defined" if not defined $DARWIN;
  if ($DARWIN) {
    # check for homebrew build:
    my $HOMEBREW_OS_VERSION = $ENV{HOMEBREW_OS_VERSION};
    if (defined($HOMEBREW_OS_VERSION) and ($HOMEBREW_OS_VERSION ne '')) {
      # assume this is a homebrew build!
      my $HOMEBREW_FAIL_LOG_LINES=$ENV{HOMEBREW_FAIL_LOG_LINES};
      if (defined($HOMEBREW_FAIL_LOG_LINES) and (int($HOMEBREW_FAIL_LOG_LINES)>0)) {
        $DISPLAYED_LINES = $HOMEBREW_FAIL_LOG_LINES;
      }
      else {
        $DISPLAYED_LINES = 15; # =default
      }
    }
  }
}
$DISPLAYED_LINES -= (1+2); # reserve space for header line + two extra lines shown after excerpt

sub min($$) { my ($a, $b) = @_; return $a<$b ? $a : $b; }

sub disarm($) {
  my ($line) = @_;
  $line =~ s/:/;/go; # avoid output gets interpreted as error message
  return $line;
}

my $P_STAR = 2;
my $P_FAILED = 4;
my $MAXPRIO  = 4;

my @count_prio = ();
for (my $i=0; $i<=$MAXPRIO; ++$i) { $count_prio[$i] = 0; }

my @listed = (); # contains refs to arrays containing [priority, line]

sub list_error($$) {
  my ($priority, $line) = @_;

  die if $priority>$MAXPRIO;
  return if not $priority;
  return if $priority==$P_STAR and $line =~ /Waiting for unfinished jobs/o;
  return if $line =~ /warning:/io;

  chomp($line);

  if ($priority==$P_STAR and scalar(@listed)) {
    my $prev_r = $listed[$#listed];
    my ($prevPrio, $prevLine) = @$prev_r;
    if ($prevPrio==$P_FAILED and $prevLine =~ /recipe.*failed/io) {
      # seen a line with '***' after 'recipe...failed' -> concat
      pop @listed;
      $line .= ' + '.$prevLine;
      --$count_prio[$prevPrio];
    }
  }

  push @listed, [ $priority, $line ];
  ++$count_prio[$priority];
}

sub print_listed() {
  my @allowed_with_prio = ();
  my @printed_with_prio = ();

  my $left = $DISPLAYED_LINES;

  for (my $i=1; $i<=$MAXPRIO; ++$i) {
    my $use = min($count_prio[$i], $left);
    $left -= $use;
    $allowed_with_prio[$i] = $use;
    $printed_with_prio[$i] = 0;

    if ($DEBUG) {
      if ($count_prio[$i]>0) {
        print STDERR "priority $i: ".$count_prio[$i]." (allowed=".$allowed_with_prio[$i].")\n";
      }
    }
  }

  foreach my $entry_r (@listed) {
    my ($priority, $line) = @$entry_r;
    if ($printed_with_prio[$priority] < $allowed_with_prio[$priority]) {
      if ($DEBUG) {
        print STDERR $priority.' | '.disarm($line)."\n";
      }
      else {
        print STDERR disarm($line)."\n";
      }
      ++$printed_with_prio[$priority];
    }
  }
}

sub short_error_summary() {
  my $log = shift @ARGV;
  die "Usage: short_error_summary.pl LOGNAME" if not defined $log;

  open(LOG, '<'.$log) || die "failed to open '$log' (Reason: $!)";
  print STDERR "---------------------------------------- [excerpt of obvious errors below; full log in $log]\n";
  while (defined($_ = <LOG>)) {
    my $priority = 0;
    if    (/error:/io)     { $priority = 1; }
    elsif (/\*\*\*/o)      { $priority = $P_STAR; }
    elsif (/error/io)      { $priority = 3; }
    elsif (/failed/io)     { $priority = $P_FAILED; }
    list_error($priority, $_);
  }
  close(LOG);
  print_listed();
}

short_error_summary();