#!/usr/bin/perl
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This routine chews up a C function  header,  including  any  comments,  and #
# output  as  standardized  function  header  of  the sort that many software #
# managers like to see. Comments will be preserved, but most blank lines will #
# be  lost.  Also, some unrecognized lines will be lost; we might fix this if #
# it becomes a problem.                                                       #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

for (<>) {
	chop;
	if (@bdy) {				# Are we in the body?
		$bdy[@bdy] = $_;	# If so, eat everything.
	} else {				# If not, what sort of line is it?
		if (/^\/\*/) {		# Start of comment.
			$com[@com] = "" if @com;
		} elsif (/^\*\/$/) {	# End of comment.
			$com[@com] = "" if @com;
		} elsif (/^\s*\*(.*)$/) {
#			$c = $1;
#			$d = &trim($c);
			$com[@com] = &trim($1);	# Line of comment.
		} elsif (/^(\s*\w+.*)/) {
			$hdr[@hdr] = $_;	# Line of function header.
		} elsif (/^\{/) {
			$bdy[@bdy] = $_;	# Start of function body.
		} elsif (/^\s*$/) {
			# Ignore blank lines.
		} else {
			$hdr[@hdr] = $_;	# Unrecognized header line.
		}
	}
}
$A = '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *';
#
# Produce the comment block, starting with the function prototype:
print "\n";
print "/$A\n";
print "* CALL:\n";
for (@hdr) {	# Run thru the header lines, converting to comments.
	$h = $_;		# Make a copy to preserve the originals.
	$h =~ s/\/\*(.*)\*\//--$1/;
#	$h =~ s/\s*\*\/*$//;
	$h =~ s/\bFCT\s+//;
	$h =~ s/\bstatic\s+//;
	$h =~ s/\bglobal\s+//;
	print "*   $h\n";
}
print "*\n";
print "* DESCRIPTION:\n";
print "*\n";
for (@com) {
	print "*",$_, "\n";
}
print "* AUTHOR: John Chambers.\n";
#rint "* AUTHOR:\n";
print "*\n";
print "* CHANGES:\n";
#rint "*\n";
print "*/\n";

# Produce the original function header:
for (@hdr) {
	print $_, "\n";
}

# Produce the original function body:
for (@bdy) {
	print $_, "\n";
}

#sub trim {
#	s'\s+$'';
#	s'\*/$'';
#	s'[ *]+$'';
#	s'\s+$'';
#	return $_;
#}
sub trim {
	local($s) = @_;
	$s =~ s'\s+$'';
	$s =~ s'\*/$'';
	$s =~ s'[ *]+$'';
	$s =~ s'\s+$'';
	return $s;
}