source: branches/tree/SOURCE_TOOLS/short_error_summary.pl

#!/usr/bin/perl

use strict;
use warnings;

my $DEBUG = 0;
# Hint: use 'make REEXTRACT' to re-extract from BUILD_LOG generated by previous 'make ALL' or similar

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];
}

my %seen = (); # key=error-line; value=number of occurrences

sub remove_duplicate_lines() {
  @listed =
    grep defined,
    map {
    my ($priority, $line) = @$_;
    if (not exists $seen{$line}) {
      $seen{$line} = 1;
      $_;
    }
    else {
      $seen{$line}++;
      --$count_prio[$priority];
      undef;
    }
  } @listed;
}

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]) {
      my $dupcount = $seen{$line};
      my $disarmedLine = disarm($line);
      if ($dupcount>1) {
        $disarmedLine .= " [occurred ".($dupcount==2 ? "twice]" : "$dupcount times]");
      }
      if ($DEBUG) {
        print STDERR $priority.' | '.$disarmedLine."\n";
      }
      else {
        print STDERR $disarmedLine."\n";
      }
      ++$printed_with_prio[$priority];
    }
  }

  my $printedAny = grep { defined $_ && $_ > 0 } @printed_with_prio;
  if (not $printedAny) { print STDERR "no obvious errors found :-(\n"; }
}

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;
    }
    # match 'error',  but not '-Werror-implicit-function-declaration' or 'arb_error':
    elsif (/(?<!-W)(?<!\barb_)error/io) {
      $priority = 3;
    }
    # match 'failed', but not 'failed_' or 'Failed : 0 =  0.0%' (=test success):
    elsif (/failed(?!_)(?![\s:0=\.%]+$)/io) {
      $priority = $P_FAILED;
    }

    list_error($priority, $_);
  }
  close(LOG);
  remove_duplicate_lines();
  print_listed();
}

short_error_summary();