#!/usr/local/bin/perl
# -*- perl -*-
#++
# FACILITY:	Building utility
#
# ABSTRACT:	Filter messages, usually from compilers and loaders, and excise
#		those which can be (deemed to be) safely ignored.
#
# ENVIRONMENT:	Perl.
#		filterWarn
#
#		Perl subroutines for parsing messages for a particular operating
#		system (based on the -uname switch) are at the end of this file.
#
# AUTHOR:	Tom Nicinski, Creation date: 16-Aug-1995
#--
#*******************************************************************************

#*******************************************************************************

$filtFacility	= 'upsfilterWarn';
$filtUtility	= 'upsfilterWarn';			# Utility name
$filtUsage	= "usage: $filtUtility [-uname OS] [-cc compiler] [-filter filterFile] [file ...]";
$filtStatus	= 0;

#
# Parse command line options.
#

select (STDOUT); $| = 1;	# Turn on flushing
select (STDERR); $| = 1;	# Turn on flushing

while (@ARGV) {
   last unless ($ARGV[$[] =~ /^-/o);

   $lclOpt = shift @ARGV;

   $lclOpt =~ m/^-uname$/o  &&                           ($filtOS{shift    @ARGV} = 1, next);
   $lclOpt =~ m/^-cc$/o     && ($ARGV[$[] =~ tr/A-Z/a-z/, $filtComp{shift  @ARGV} = 1, next);
   $lclOpt =~ m/^-filter$/o &&                     (push (@filtFile, shift @ARGV),  next);

   print STDERR "$filtFacility: ERROR: invalid option: $lclOpt\n";
   $filtStatus = 2;
}

if ($filtStatus != 0) {
   print STDERR $filtUsage, "\n";
   exit ($filtStatus);
}

($filtOS = `uname`) =~ s/\n*$//o;			# Caller's OS
 $filtOS{$filtOS} = 1 if (scalar (keys (%filtOS)) == 0); # Default selected OS

#
# Check whether the specified operating systems can be handled.
#

foreach $filtParseOS (keys (%filtOS)) {
   if (! eval "defined (&filtParse_${filtParseOS})") {
      undef ($filtOS{$filtParseOS});
      print STDERR "$filtFacility: $filtParseOS operating system (-uname) not handled by $filtUtility\n";
   }
}

#*******************************************************************************

#*******************************************************************************
#
# Define what's acceptable and what's not.
#

sub fe {					# Filter entry declartion
   local ($argOS)   = shift @_;
   local ($argComp) = shift @_; $argComp =~ tr/A-Z/a-z/;  # Case-insensitive

   $filtFileEnt++;				# For warnings

   #
   # Possibly reduce the number of filter entries (to improve performance):
   #
   #    o   Omit entries whose OS or compiler are not being looked at.
   #

   return if (    (($argOS   ne '') && ! defined ($filtOS{$argOS}))
              || ((($argComp ne '') && ! defined ($filtComp{$argComp}) && (scalar (keys (%filtComp)) > 0)))
             );

   #
   # Generate a conditional to apply filtering criteria against input lines.
   #
   #   o   The lines are incorporated directly into the &filtInput subroutine
   #       loop reading input lines.  When an input line is filtered out, a
   #       'next' will cause control to skip to the next input line.  If the
   #       filter entry fails, control falls through to the next filter entry.
   #
   #   o   The conditional is appended to an associative array member with the
   #       operating system name ($argOS) as the index.  This is done also for
   #       filter entries where no operating system is specified.
   #

   if (@_ == 0) {			# Ignore a line with no criteria
      print STDERR "$filtFacility: WARN: empty filter entry (besides OS/compiler) ignored: $filtFile, entry $filtFileEnt\n";
      return;
   }

    $lclSep   = '';			# Separator between conditional elements
    $lclFilt  = '';

   ($lclFilt .=        "(\$src  eq '$argSrc')",			$lclSep = '&&') if (($argSrc    = shift @_) ne '');
   ($lclFilt .= "$lclSep(\$sev  eq '$argSev')",			$lclSep = '&&') if (($argSev    = shift @_) ne '');
   ($lclFilt .= "$lclSep(\$num  ==  $argNum)",			$lclSep = '&&') if (($argNum    = shift @_) ne '');
								                     $argXtra   = shift @_;
   ($lclFilt .= "$lclSep(\$file =~ m\007$argFileRE\007o)",	$lclSep = '&&') if (($argFileRE = shift @_) ne '');
   ($lclFilt .= "$lclSep(\$text =~ m\007$argTextRE\007o)",	$lclSep = '&&') if (($argTextRE = shift @_) ne '');
								                     $argParse  = shift @_;
   #
   # Passed all but parseExpr filtering criteria for this entry.
   #
   #   o   Extra lines are in the array variable @filtXtra.
   #

   $filtLine{$argOS} .= "if ($lclFilt) {\n" if ($lclFilt ne '');

   if ($argParse ne '') {
      if (($argXtra ne '') && ($argXtra > 0)) {
        $filtLine{$argOS} .= "for (\$cnt = \@filtXtra; \$cnt < $argXtra; \$cnt++) {\n";
        $filtLine{$argOS} .= "   push (\@filtXtra, scalar (<>));\n";	# Get extra line
        $filtLine{$argOS} .= "}\n";
      }
      $filtLine{$argOS} .= "if ($argParse ne '') {\n";
   }

   #
   # Filter out the line and any associated extra lines.
   #

   if (($argXtra ne '') && ($argXtra > 0)) {
      $filtLine{$argOS} .= "for (\$cnt = 0; \$cnt < $argXtra; \$cnt++) {\n";
      $filtLine{$argOS} .= "   \$_ = (\@filtXtra) ? shift (\@filtXtra) : <>;\n"; # Ignore extra line
      $filtLine{$argOS} .= "}\n";
   }
   $filtLine{$argOS} .= "next;\n";		# Filter out the line

   $filtLine{$argOS} .= "}\n" if ($argParse ne '');
   $filtLine{$argOS} .=	"}\n" if ($lclFilt  ne '');
}

#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Read in filter definitions.
#
#   o	An error here is NOT fatal, but the user will receive less filtering.
#

foreach $filtFile (@filtFile) {
   if      (! -e $filtFile) { print STDERR "$filtFacility: WARN: file does not exist: $filtFile\n";
   } elsif (! -r $filtFile) { print STDERR "$filtFacility: WARN: unable to read file: $filtFile\n";
   } else {
          $filtFileEnt = 0;		# Reset for &fe warnings
      do "$filtFile";
      print STDERR "$filtFacility: WARN: error loading $filtFile\n$@" if ($@);
   }
}

#*******************************************************************************

#*******************************************************************************
#
# Filter out lines to be ignored.
#
#   o	Filtering is done for the selected operating systems.
#
#   o	If a filtered line has any extra lines associated with it, they're
#	removed too.
#
#	   o	Extra lines are in @filtXtra.  If the current line is NOT
#		filtered out, then input will be taken from @filtXtra first
#		before reading from the input stream.
#
#   o	The code is run-time compiled for better efficiency filter a large
#	number of input lines rather than for quick initialization.  This is
#	accomplished through inline testing (with much code duplication) rather
#	than using loops.
#

$[ = 0;					# Guarantee 0-indexing for @filtXtra

print STDOUT "$filtFacility: output filtered through $filtUtility (uname = ", join (', ', keys (%filtOS)), ")\n\n";

#
#   o	The subroutine &filtInput reads all input lines and checks each against
#	all passed OSes.  If a line matches the format for a particular OS:
#
#	   o	it is a candidate for filtering by entries specified (with &fe)
#		for BOTH that OS and entries without any specified OS.
#
#	   o	if the line is filtered out, $filtLine{$OS} (or $filtLine{''})
#		will go to the next input line with a 'next' statement.
#
#	   o	if the line is NOT filtered out, then it is parsed for the next
#		OS and the process of filtering begins anew.
#
#	The &filtInput subroutine is basically an inline lists of conditionals.
#	This is more time-efficient than (for a large number of input lines)
#	than looping around each OS candidate.
#

foreach $OS (keys (%filtOS)) {
   $filtSub .= "(\$src, \$sev, \$num, \$file, \$line, \$text) = \&filtParse_$OS;\n"
            .  "if (\$text ne '') {\n"
            .     "${filtLine{$OS}}"		# "\n" already in there
            .     "${filtLine{''}}"		# "\n" already in there
            .  "}\n";
}

undef %filtLine;				# Free up any space

eval ("sub filtInput {\n"
    .    "while ( (\$_ = (\@filtXtra) ? shift (\@filtXtra) : <>) ne '') {\n"
    .       "$filtSub"
    .       "print STDOUT \$_;\n"
    .    "}\n"
    . "}\n");

undef $filtSub;					# Free up any space

&filtInput;					# Filter the input

exit (0);					# Show success

#*******************************************************************************

#*******************************************************************************
#
# Provide parsers based on OS type.
#
#   o	They all return the following information in an array:
#
#	   src	message source
#	   sev	message severity.  This must be a single uppercase letter.
#	   num	message number
#	   file	file
#	   line	line within the file
#	   text	message text
#
#	Not all value will be returned necessarily.  In order to filter out any
#	input line, a parsing subroutine should return, at a minimum:
#
#	   return (undef, undef, undef, undef, undef, $_);
#
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub filtParse_IRIX {

   local ($lclSev);

   #
   # cc compiler.
   #
   # cfe: Error: dscLine.c: 53: Cannot open file mv167sup.h for #include
   #
   # cfe: Warning 822: dscLine.c, line 53: control may fall through labeled statement
   #

   if (m/^([^:]+):\s*(\w)\w+\s*([0-9]*):\s*(\S+)(,\s*line)?\s+([0-9]+):\s*(.+)$/o) {
      ($lclSev = $2) =~ tr/a-z/A-Z/;
      return ($1, $lclSev, $3, $4, $6, $7);
   }

   #
   # ld loader.
   #
   # Warning: /p/IRIX/pgplot/v5_0_1/dst/libpgplot.a(mfdriv.o): mfdriv_: multiply defined
   #         previous (used) definition from '/p/IRIX/fpgplot/v1_0/lib/libfpgplot.a';
   #         new (ignored) definition from '/p/IRIX/pgplot/v5_0_1/dst/libpgplot.a'

   if (m/^(W)arning:\s*([^\(]+\([^\)]+\)):\s*(.*)$/o) {
      ($lclSev = $1) =~ tr/a-z/A-Z/;
      return (undef, $lclSev, undef, $2, undef, $3);
   }

   #
   # ar.
   #
   # /usr/lib/ar: Warning:ignoring second definition of argvConstant__9SignatureCFUi define in archive

   if (m/^\/usr\/lib\/(ar): (W)arning:\s*(.+)$/o) {
      ($lclSev = $2) =~ tr/a-z/A-Z/;
      return ($1, $lclSev, undef, undef, undef, $3);
   }

   #
   # C++ compiler.
   #
   # "../include/arParamValue.ddl", line 16: warning(3262): parameter "clientdata" declared and unreferenced
   if (m/^"([^"]+)",\s*line\s+([0-9]+):\s*(\w)\w+\(([0-9]+)\):\s*(.+)$/o) {
      ($lclSev = $3) =~ tr/a-z/A-Z/;
      return (undef, $lclSev, $4, $1, $2, $5);
   }

   #
   # ooddlx.
   #
   # "../include/arParamValue.ddl", line 16: warning: persistent-capable class
   if (m/^"([^"]+)",\s*line\s+([0-9]+):\s*(\w)\w+:\s*(.+)$/o) {
      ($lclSev = $3) =~ tr/a-z/A-Z/;
      return (undef, $lclSev, undef, $1, $2, $4);
   }

   return (undef);
}

sub filtParse_IRIX64
{
   #
   # cc compiler.
   #
   # "tclUtils.c", line 96: remark(1174): parameter "clientData" was declared but never referenced
   #
   if (/^"([^"]+)",\sline\s(\d+):\s(error|warning|remark)\((\d+)\):\s(.+)$/o) {
      $file = $1;
      $line = $2;
      $type = $3;
      $num = $4;
      $msg = $5;

      $inline = $_;
      while(<>) {		# read rest of message
	 last if(/^\s+$/);
	 chop;
	 $msg .= " $_";
	 $inline .= "$_\n";
      }
      $_ = $inline;

      if($type =~ /(warning|remark)/) {
         $type = "W";
      } else {
         $type = "E";
      }
      return (undef, $type, $num, $file, $line, $msg);
   } elsif(/(ld(32|64)): WARNING (\d+): (.*)/) {
      $file = "";
      $line = "";
      $type = "W";
      $num = $3;
      $msg = $4;

      return (undef, $type, $num, $file, $line, $msg);
   }

   return(&filtParse_IRIX);
}

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

sub filtParse_gcc {

   local ($lclSev);

   #
   # gcc compiler.
   #
   # ./dscLine.c:1412: warning: assignment from incompatible pointer type
   # dscSCD.c:3773: macro `stsArr' used with only 2 args
   #

   if (m/^([^:]+):\s*([0-9]+)\s*:\s*(\w)\w+\s*:\s*(.+)$/o) {
      ($lclSev = $3) =~ tr/a-z/A-Z/;
      return (undef, $lclSev, undef, $1, $2, $4);
   }

   if (m/^([^:]+):\s*([0-9]+)\s*:\s*(.+)$/o) {
      return (undef, undef,   undef, $1, $2, $3);
   }

   if (m/^([^:]+):\s*(In function\s+.*)$/o) {
      return (undef, undef,   undef, $1, undef, $2);
   }

   if (m/^In file included from\s+([^:]+):\s*([0-9]+)[,:]/o) {
      local ($lclLine) = $_; $lclLine =~ s/\n+$//o;
      return (undef, undef,   undef, $1, $2, $_);
   }

   return (undef);
}

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

sub filtParse_Linux {

   local ($lclSev);
   return (&filtParse_gcc);		# Linux uses gcc by default
}

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

sub filtParse_VxWorks {

   local ($lclSev);

   #
   # cc68k compiler.
   #
   # ./dscLine.c:1412: warning: assignment from incompatible pointer type
   # dscSCD.c:3773: macro `stsArr' used with only 2 args
   #

   return (&filtParse_gcc);		# Both compilers are equivalent
}

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

sub filtParse_SunOS {

   local ($lclSev);

   #
   # acc compiler.
   #
   # "/usr/include/sys/time.h", line 64: warning: tokens ignored at end of directive line
   #

   if (m/^"([^"]+)",\s*line\s+([0-9]+):\s*(\w)\w+:\s*(.+)$/o) {
      ($lclSev = $3) =~ tr/a-z/A-Z/;
      return (undef, $lclSev, undef, $1, $2, $4);
   }

   #
   # ar
   #
   # ar: filename tclSaoMaskDisplay.o truncated to tclSaoMaskDispl
   # ar: creating ../lib/libshiva.a
   #

   if (m/^ar(:|\s)/) {
      if (m/^(ar):\s*filename\s+(\S+)\s+(.*)$/o) {
         return ($1, undef, undef, $2, undef, "filename $3");
      }

      if (m/^(ar):\s*creating\s+(.*)$/o) {
         return ($1, undef, undef, $2, undef, "creating $2");
      }

      if (m/^(ar)\s+(\S)\s+(\S+)\s+(.*)$/o) {
         return ($1, undef, undef, $3, undef, "$2 $3 $4");
      }

      if (m/^(ar)(:|\s)\s*(.*)$/o) {
         return ($1, undef, undef, undef, undef, $3);
      }
   }

   #
   # ld
   #
   # ld: Undefined symbol 
   #    _alloca
   #

   return (undef, undef, undef, undef, undef, $_);
}

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

sub filtParse_OSF1 {

   local ($lclSev);

   #
   # cc
   #
   # /usr/lib/cmplrs/cc/cfe: Error: tclSaoDraw.c: 49: Cannot open file tcl.h for #include
   #
   # cc: Warning: tree.c, line 257: The last statement in non-void function "shTreeNodeFind" is not a return statement.
   # TNODE *
   # ^
   #

   if (m/^[^:]*\/?([^:]+):\s*(\w)\w+:\s*(\S+)(,\s*line)?\s+([0-9]+):\s*(.+)$/o) {
      ($lclSev = $2) =~ tr/a-z/A-Z/;
      return ($1, $lclSev, undef, $3, $5, $6);
   }
   # C++ compiler
   if (m/^([^:]+):([0-9]+):\s*(\w)\w+:\s*(.+)$/o) {
       ($lclSev = $3) =~ tr/a-z/A-Z/;
       return ("cxx", $lclSev, undef, $1, $2, $4);
    }
 # Make
 #   if (m/^([^:]+):([0-9]+):\s*(\w)\w+:\s*(.+)$/o) {
 #      ($lclSev = $3) =~ tr/a-z/A-Z/;
 #      return ("cxx", $lclSev, undef, $1, $2, $4);
 #   }

   return (undef);
}

#*******************************************************************************
