stlfilt.pl

STLstlfilt.zip

	{												     # (just "/closewrap" means Y)
		$close_wrap = "\u$1";
		$close_wrap = 'Y' if $close_wrap eq "";
		shift;
		next;
	}

	if ($ARGV[0] =~ /^[\/-]meta:?([YN]?)[A-Z]*$/i)		 # meta:Y or N
	{												     # (just "/meta" means Y)
		if ("\u$1" =~ /^N/)
		{
			$break_algorithm = 'P';
		}
		else
		{
			$break_algorithm = 'D';
			$comma_wrap = $meta_y_cbreak;
			$close_wrap = $meta_y_closewrap;
		}
		$output_width = 80 if $output_width == 0;
		shift;
		next;
	}

	if ($ARGV[0] =~ /^[\/-]lognative/i)				# allow log native msgs option
	{												# of form: /lognative
		$lognative = 1;
		shift;
		next;
	}

	if ($ARGV[0] =~ /^[\/-]banner:?([YN]?)[a-zA-Z]*$/i) # banner:Y or N
	{												 # (just "/banner" means Y)
		$banner = "\u$1";
		$banner = 'Y' if $banner eq "";
		shift;
		next;
	}

	if ($ARGV[0] =~ /^[\/-]plg/i)					# .PLG file mode
	{
		$plg = 1;
		shift;
		next;
	}

	if ($ARGV[0] =~ /^[\/-]/)
	{
		print "STLFilt.pl: Unrecognized option: $ARGV[0]\n";
		shift;
		next;
	}

	last;
}

break_and_print "$STLFilt_ID\n" if $banner eq 'Y';

#
# This sections builds the $t ("type") regex from the ground up. 
# After it is built, the component variables (except for $id) are not used again.
#

$sid = '\b[a-zA-Z_]\w*';						# pattern for a simple identifier or keyword
$id = "(?:$sid\:\:)*$sid";						# simple id preceded by optional namespace qualifier(s)

$p = '(?: ?\*)*';								# suffix for "ptr", "ptr to ptr", "ptr to ptr to ptr", ad nauseum.
$idp = "(?:$id )*$id ?$p ?";					# one or more identifiers/keywords with perhaps some *'s after

												# simple id or basic template spec
$cid = "(?:$idp(?: ?const ?\\*? ?)?|$id<$idp(?: ?const ?\\*? ?)?(?:,$idp(?: ?const ?\\*? ?)?)*>$p) ?";

												# a cid or template type with 1+ cid's as parameters
$t = "(?:$cid|$id<$cid(?:,$cid)*>$p|$id<$id<$cid>$p(?:,$id<$cid>$p)* ?>$p)";


$dotNET = 0;									# have we detected .NET-style messages yet? no
$justWith = 0;									# did we see a line with just "with" on it? no, not yet
$long_id = 0;									# was the previous message a long identifier warning? no

showkey $output_width if $pdbg;

lognative_header if $lognative;


#
# Data structures supporting the Dave Abrahams mode line break algorithm:
#

@open_delims = ('(', '{', '<');
@close_delims= (')', '}', '>');

for (@open_delims)	# list of "open" delimiters
{
	$open_delims{$_}++;
}

for (@close_delims)	# list of "close" delimiters
{
	$close_delims{$_}++;
}

# create "opposites" table, mapping each delimiter to its complement:
for ($i = 0; $i < @open_delims; $i++)
{
	$opps{$open_delims[$i]} = $close_delims[$i];
	$opps{$close_delims[$i]} = $open_delims[$i];
}

$improperly_broken_line = 0;		# processing a line with inappropriate CRLF at the end?
$accumulated_line = "";				# if so, this holds all segments of that line seen so far.


#
# NOTE: We cannot use a main loop of the form
#
# while( <> )
#
# because of ActivePerl's way of handling input from  Win32 pipes 
# connected to STDIN. (EOF is treated like an ordinary character. 
# In particular, it doesn't get read unless FOLLOWED by a newline.
# Yeah, great, EOF followed by a newline.)
#

MAIN_LOOP:
while ( 1 )
{
  # Read the first char of the next line to see if it equals EOF.
  # If we're the ones who write the code that writes to STDIN,
  # we can guarantee that EOF is always preceded by a newline.
  #
  # We must do this in a loop, because if the next line is empty,
  # then we have not read the first char of the next line, but 
  # the entire next line.
  #
  $newlines = "";

  CHECK_FOR_EOF_LOOP: 
  while( 1 )
  {
    # Read one char.
    $nextchar = "";
    $numRead = read STDIN, $nextchar, 1;
    
    # Normally, perl will return an undefined value from read if the next
    # character was EOF. ActivePerl will simply read the EOF like any other
    # character. Since we know that one of the newlines was ours, we print one 
    # less newline than we have seen. NOTE: It is possible that we have seen no 
    # newline at all. This happens if the CL output has no newline at the end. 
    # In that case, we have appended a newline, and that's good.

    if (1 != $numRead or $nextchar eq "\032") 
    {
      if ($newlines ne "")
      {
		chop $newlines;
		print $newlines;
      }
      last MAIN_LOOP;
    }
    else    # Else, if we have read a newline, we store it for later output and continue reading.
	{
	  if ($nextchar eq "\n")
	  {
		$newlines = $newlines . "\n";
	  }

	  # Else, if we have read something that's neither a newline nor EOF, we print
	  # the accumulated newlines and proceed to read and process the next line.

	  else
	  {
		print $newlines;
		last CHECK_FOR_EOF_LOOP;
	  }
	}
  }

  # Read the next line, prepend the first char, which has already been read.
  $_ = <STDIN>;

  # If the read failed, the pipe must have broken.
  if (!defined $_)
  {
	print "\nSTL Decryptor: Input stream terminated abnormally (broken pipe?)\n";
    last MAIN_LOOP;
  }

  $_ = $nextchar . $_;


  # Do these transformation immediately, so the `...' pairs don't appear as mismatched when looking
  # for even numbers of single quotes:

  s/`anonymous[- ]namespace'/anon_ns/g;		# massage anonymous namespace specs to qualify as identifiers
  s/``global namespace''/ \$global namespace\$/g;	# massage this too so as to not confuse quote counters
  s/`([^']*)'/$1/g;							# change `anything' to anything (typical: operator`+' -> operator+)

  # Check for long line wrapped by IDE with an improper CRLF:

  if ($improperly_broken_line)				# if processing line(s) with improper CRLF termination
  {
	  chomp $accumulated_line;
	  $accumulated_line .= $_;
	  next if /^\S/;						# if line does not begin with whitespace, "glue" to previous
	  
	  $_ = $accumulated_line;				# else done accumulating.
	  $accumulated_line = "";				# clear the accumulation buffer
	  $improperly_broken_line = 0;			# and clear the flag to indicate we're no longer "accumulating".
  }
  elsif (tr/'// % 2 == 1)					# if an odd number of single quotes
  {
	  $improperly_broken_line = 1;			# then go look for more pieces of the line to glue together
	  $accumulated_line = $_;
	  next;
  }

  $save_line_for_dbg = $_;					# in case of a panic error

  print LOGNATIVE $_ if $lognative;			# log native message if requested

  if ($plg)									# If processing .PLG file
  {						
	if ($doing_brackets)
	{
		$doing_brackets = 0 if /^]/;		# Done "doing brackets" if we see a "]" line
		next;
	}
	if (/^\[/)								# A "[" line means we're about to start skipping until we see a "]" line
	{
		$doing_brackets = 1;
		next;
	}
	
	if (/---Configuration/)					# Pass through all "Configuration" lines as they are
	{
		print;
		next;
	}

    if (!$plg_sawcompiling)
	{
		next if !/Compiling\.\.\.$/;		# Skip everything until we see "Compiling..."
		$plg_sawcompiling = 1;				# Then mark that we did see it.
		print "Compiling...\n";				# Spit it out without the HTML, thank you very much
		next;
	}

	next if /^Creating [^l]/;				# permit "Creating library", but not "Creating" anything else
	next if /BD Software Proxy CL/;
	next if /^</;							# suppress all HTML
  }

  if (/^([^;]*\(\d+\)) ?\:/)				# strip prefix of form: 
  {											#   "pathname(n) : "
	  $oldprefix = "$1 :";					# and conditionally replace later with:
											#   "pathname(n):"   (note how space goes away)
	  $prefix = ($keep_space_pre_colon ? $oldprefix : "$1:");
	  s/^\Q$oldprefix//;					# remove the old prefix
  }
  elsif (/^(.*\.c(pp|xx))$/)				# if line ends with ".cpp" or ".cxx",
  {											#	then assume it is just a filename and don't filter
	  print;								# don't bother filtering the line with just
	  next;									# the filename on it
  }
  else
  {	
	  $prefix = "";							# dummy prefix value
  }

  $prefix =~ s/^        /$tab/;

  next if /was declared deprecated/ and $hide_deprecated_warns;
  next if /compiler has generated/ and $hide_generated_warns;

  s/\boperator`(\w[^']*)'/operator $1/g;	# obscure case involving conversion operators and quote marks


  ##################################################################################################
  # Do "with"-clause substitutions, to transform into old-style messages (native CL's /WL option required):

  if ($with_policy eq 'S')
  {
	  $justWith = 1 if /^ *with *$/;	# so we can remind folks to use /WL when the dust settles...

	  while (/'(([^']*)( with \[([^']*)\]))/)
	  {
		  $dotNET = 1;					# OK, now we know we're dealing with .NET messages...
		  $text = $2;					# the original message text with placeholder names
		  $keyclause = $3;				# the "with [...]" clause
		  $keylist = $4;				# just the list of key/value mappings

		  %map = ();					# clear the hash of key/value pairs

		  while($keylist =~ /(\w+)=/)
		  {
			  $key = $1;
			  $pos = $start = index($keylist, $key) + length($key) + 1;

			  $depth = 0;				# count <'s and >'s
			  $previous = ' ';
			  while ($pos <= length($keylist))
			  {
				  $next = substr ($keylist, $pos++, 1);
				  last if $depth == 0 and  ($next eq ',' or ($next eq ']' and $previous ne '['));    # ignore "[]"
				  $depth++ if $next =~ /[<\[\(]/;
				  $depth-- if $next =~ /[>\]\)]/;
			  }

			  $value = substr($keylist, $start, $pos - $start - 1);
			  $map{$key} = $value;
			  last if $pos > length($keylist);
			  $keylist = substr($keylist, $pos);
		  }

	  # Apply substitutions to the original text fragment:

		  $newtext = $text;
		  while(($key, $value) = each(%map))
		  {
			  $newtext =~ s/\b$key\b/$value/g;
		  }

	  # Replace the original message text with the expanded version:

		  s/\Q$text/$newtext/;

	# Delete the key/value list from the message: