
# **************************** LICENSE START ***********************************
#
# Copyright 2012 ECMWF and INPE. This software is distributed under the terms
# of the Apache License version 2.0. In applying this license, ECMWF does not
# waive the privileges and immunities granted to it by virtue of its status as
# an Intergovernmental Organization or submit itself to any jurisdiction.
#
# ***************************** LICENSE END ************************************

# *****************************************************************************
# Perl script to automatically document all Metview macros for use
# with the modified NEdit editor.
#
# Command-line options:
#   -debug=?  where ? = 0, 1, 2, or 3
#      This sets the level of debug information that is output.
#      (0 - none; 1 - important only; 2 - detailed, 3 - very detailed)
#
# Description:
#   It first examines the environment variable METVIEW_MACRO_PATH.
#   For each directory specified therein (that exists), each text
#   file is examined for documentation. It is assumed that a macro
#   has adopted a standard format for its header comments. This header
#   section should be at the start of the file and contain a number of
#   specific fields, formatted in the following style:
#
#     # FIELD_NAME    : FIELD_VALUE_LINE_1
#     #                 FIELD_VALUE_LINE_2
#     #                 FIELD_VALUE_LINE_N
#
#   For example:
#
#     # Function      : mvl_regular_layout
#     #
#     # Syntax        : list mvl_regular_layout (definition, number, number,
#     #                                          number, number)
#
#   For more examples, see the supplied Metview Macro Library functions.
#   Note that a multi-line value that starts with a blank line must
#   have at least one space after the colon which follows the field name.
#   The search for field names is case-insensitive.
#
#   First, the fields required for the macro index file are retrieved.
#   These are 'Category', 'Function' and 'OneLineDesc'. If one or more of
#   these fields are missing, then the macro will not appear in the index.
#
#   Then, the fields required for the calltips file are retrieved.
#   These are 'Function', 'Syntax', 'Parameters', 'Description',
#   'Return Value' and 'Example Usage'. These fields are all optional
#   except for 'Function' which is necessary.
#
#
# Authorship:
#   Iain Russell, ECMWF
#   Started 24th November 2003
#   Last modified: 29th November 2004
# *****************************************************************************


# ---------------
# Useful globals
# ---------------

# $debug             = 1;  # set this to override the command-line option

$max_category_length = 8;
$num_spaces_for_tab  = 8;  # we substitute tabs with spaces - but how many?



# -------------------------------------------------------------------------
# Step 0 - determine the output files to create - and open them for writing
# -------------------------------------------------------------------------

$strUserDir = $ENV{'METVIEW_USER_DIRECTORY'}  || die ('Could not retrieve environment variable METVIEW_USER_DIRECTORY.');
$strOutDir  = "$strUserDir/..macro_editor";

# Create strOutDir if it does not exist

if (!-d $strOutDir)
{
	mkdir($strOutDir, 0755) || die "Cannot mkdir $strOutDir";
}



$macro_index_file    = "$strOutDir/macro_index_unsorted.txt";    # unsorted macro index
$macro_index_file_s  = "$strOutDir/macro_index.txt";             # sorted macro index
$macro_calltips_file = "$strOutDir/macro_calltips.txt";          # macro calltips file

open(INDEX_FILE,        ">" . $macro_index_file);     # open for write, overwrite
open(INDEX_FILE_SORTED, ">" . $macro_index_file_s);   # open for write, overwrite
open(CALLTIPS_FILE,     ">" . $macro_calltips_file);  # open for write, overwrite



# -----------------------------------------------------------
# Step 1 - extract the list of all Metview macro directories.
#          This is contained in an environment varaible as
#          colon-separated paths.
# -----------------------------------------------------------

$strPathList = $ENV{'METVIEW_MACRO_PATH'};

@PathList = split(/:/, $strPathList);

debug_print ("@PathList\n", 2);



# --------------------------------------------------------
# Step 2 - for each directory, document all macros therein
# --------------------------------------------------------

foreach $dir (@PathList)
{
	debug_print ("$dir\n", 2);

	# Does this directory actually exist?

	if (opendir(DIR,"$dir"))
	{
		# Yes - examine each file in turn

		while ($file = readdir(DIR) )
		{
			if (is_file_a_metview_macro ($dir, $file))
			{		
				document_macro ("$dir/$file");
			}
		}
	}

	else
	{
		debug_print("Directory $dir is in the macro search list, but does not exist.\n", 1);
	}

	closedir(DIR);
}


close (INDEX_FILE);
close (CALLTIPS_FILE);


# -----------------------------
# Step 3 - sort the index file
# -----------------------------

open  INDEX_FILE,$macro_index_file or die "cant open index file $!\n";
print INDEX_FILE_SORTED sort (<INDEX_FILE>);   #or if you need: @lines=sort <MYFILE>;
close INDEX_FILE;
close INDEX_FILE_SORTED;


# remove the temporary unsorted index file

unlink ($macro_index_file);









# ----------------------------------Subroutines ----------------------------------






# ******************************************************************
# Subroutine: is_file_a_metview_macro
#   Determines whether the given file is a Metview macro file or not
#   Ok, it's not absolutely accurate, but at least rules out the most
#   obvious imposters. We'll later look at the contents of the file
#   to ensure it's a documentable macro.
# Parameter 1 ($_[0]): the root path
# Parameter 2 ($_[0]): the filename
# ******************************************************************

sub is_file_a_metview_macro
{
	# Read the input parameters

	local($dir)  = $_[0];
	local($file) = $_[1];
	local($path) = "$dir/$file";


	# Does the filename begin with a dot?
	
	$first_char = substr ($file, 0, 1);

	if ($first_char eq '.')
	{
		# Yes - then it's either a directory or a 'dot' file

		return (0);
	}
	
	else
	{
		# No - but is it a text file?
		
		$file_type = `file $path`;
		
		return ($file_type =~ /text/);
	}
}

# End of subroutine 'is_file_a_metview_macro'


# *****************************************************************
# Subroutine : document_macro
# Documents the given macro
# Parameter 1 ($_[0]) : the path to the macro to document
# *****************************************************************

sub document_macro
{
	# Read the input parameters

	local($file) = $_[0];
	local($function);
	local($category);
	local($one_line);
	local($pad);
	local($syntax);
	local($parameters);
	local($return_value);
	local($description);
	local($example_usage);

	debug_print ("documenting $file\n", 2);


	# Read the file and parse, line by line
	# OK, a Perl magician may be able to come up with a more
	# concise way of doing this, but this method will work.

	open (FILE, $file) || die "cannot open file $file";

	@Lines = <FILE>;


	# Note - we are passing by reference, hence the '\'
	# before each argument

	# Get the text required for the index file

	$function = get_header_field (\@Lines, \"Function");
	$category = get_header_field (\@Lines, \"Category");
	$one_line = get_header_field (\@Lines, \"OneLineDesc");

	if ($function && $category && $one_line)
	{
		$category = "-$category-";
		$pad = sprintf ('%-9s%-21s%s', $category, "$function()", $one_line);
	
	    print INDEX_FILE "$pad\n";
	}
	
	else
	{
		debug_print ("  File $file did not have enough header information for the index file.\n", 1);
	}


	
	# Get the text required for the calltips file
	
	$syntax        = get_header_field (\@Lines, \"Syntax",        0);
	$parameters    = get_header_field (\@Lines, \"Parameters",    2);
	$description   = get_header_field (\@Lines, \"Description",   2);
	$return_value  = get_header_field (\@Lines, \"Return value",  2);
	$example_usage = get_header_field (\@Lines, \"Example usage", 2);

	if ($function)
	{
		print CALLTIPS_FILE "\n";
		print_header_field ($function);
		print_header_field ($syntax);
		print_header_field ($description,   "Description:");
		print_header_field ($parameters,    "Parameters:");
		print_header_field ($return_value,  "Return value:");
		print_header_field ($example_usage, "Example usage:");
		print CALLTIPS_FILE "\n";
	}


	close(FILE);
}

# End of subroutine 'document_macro'



# ******************************************************************
# Subroutine : get_header_field
# Retrieves, as a string, the value for the given field.
# Parameter 1 ($_[0]): the set of lines comprising the file
# Parameter 2 ($_[1]): the name of the field (eg 'Syntax')
# Parameter 3 ($_[2]): the number of spaces to left-pad the result
# ******************************************************************

sub get_header_field
{
	# Read the input parameters and define local variables
	# Note that we pass the arguments by reference, not value.

	local($lines)       = @_[0];
	local($field)       = @_[1];
	local($num_spaces)  = @_[2];
	local($state)       = "finding first line";
	local($value)       = "";
	local($line_value)  = "";
	local($got_line)    = 0;
	local($left_padding); # number of extra spaces we need to remove
	local($spaces)       = sprintf("%-$num_spaces" ."s", "");
	local($tab_spaces)   = sprintf("%-$num_spaces_for_tab" ."s", "");
	local($newline)      = ""; # can be "" or "\n"
	local($valid_length) = 0;  # used then chopping extra lines off the end
	local($done)         = 0;  # set to 1 when we've finished with this field
	
	debug_print ("\n\nSEARCHING for field $$field\n", 3);

	foreach $line (@$lines)
	{
		# First, replace any tabs with spaces
		
		$line =~ s/\t/$tab_spaces/g;
		$got_line = 0;
	
	
		# Check what state we're in
		
		if ($state eq "finding first line")
		{
			# We're looking for the first line of this
			# field. Use a reglular expression to match
			# the desired field. Also note the amount of padding
			# we'll need to make subsequent lines match up.

			if ($line =~ /^(# $$field\s*: )(.*)/i)
			{
				$line_value   = $spaces . $2;
				$left_padding = length($1);
				$newline      = "";  # do not add a newline
				$got_line     = 1;
				$state        = "copying field body";
			}
		}
		elsif ($state eq "copying field body")
		{
			# For multi-line fields, we continue looking
			# until we find the start of a new field.

			if ($line !~ /^# \S.*: .*/)  # is this not the start of a new field?
			{
				if ($line =~ /^(# *.*)/)  # is it still a comment?
				{
					if ($line =~ /(^#\s*$)|(^#\s*\*+\n$)|(^\s*$)/)  # blank line (ie comment, whitespace)?
					{
						# Yes - whitespace. We also need to replace that with a dot.

						$line_value = ".";
					}
					else
					{
						# A valid line

						$line_value = $spaces . substr($1, $left_padding, length($1) - $left_padding);
					}
					
					

					$newline  = "\n";
					$got_line = 1;
					$state    = "copying field body";
				}
				
				else
				{
					# This line is not a comment. Therefore assume that we are
					# past the comment header bock.

					$done = 1;
				}
			}
			else
			{
				# Ok, a new field, so we're done.

				$done = 1;
			}
		}
		else
		{
			print "get_header_field in impossible state: $state\n";
		}




		# If the result is just whitespace, then make it into a dot

		if (($got_line) && ($line_value =~ /(^\s*$)/))
		{
			$line_value = ".";
		}


		# In case there's nothing more of
		# interest until the next field, make a
		# note of the length of the value so far
		# so we can revert back.

		if (($line_value eq ".") && ($state ne "finding first line"))
		{
			if ($valid_length == 0)
			{
				$valid_length = length ($value);
			}
		}
		
		else
		{
			$valid_length = 0; # reset this flag as we have a text-containing line
		}

		$value = $value . $newline . $line_value;

		
		
		# Have we reached the end of the field? If so,
		# remove any trailing newlines (and dots)

		if ($done)
		{
			if ($valid_length != 0)
			{
				$value = substr($value, 0, $valid_length);
			}

			$state = "done";
			debug_print('field found\n', 3);
			last;
		}
	}
	
	return ($value);
}

# End of subroutine 'get_header_field'


# ******************************************************************
# Subroutine : print_header_field
# Prints the given field if it exists to the calltips file
# Parameter 1 (@_[0]): field text to print
# Parameter 2 (@_[1]): optional header to print before the value
# ******************************************************************

sub print_header_field
{
	# Read the input parameters and define local variables
	# Note that we pass the arguments by reference, not value.

	local($field)  = @_[0];
	local($header) = @_[1];


	# Is the field non-blank?

	if ($field)
	{
		# Is the header non-blank?

		if ($header)
		{
			print CALLTIPS_FILE ".\n$header\n";
		}

		print CALLTIPS_FILE "$field\n";
	}
}

# End of subroutine 'print_header_field'



# ******************************************************************
# Subroutine : debug_print
# Prints the given string if debug is on
# Parameter 1 ($_[0]): text to print
# Parameter 2 ($_[1]): debug level to print it at
# ******************************************************************

sub debug_print
{
	local($text)  = @_[0];
	local($level) = @_[1];

	# Are we at a high enough debug level to print this text?

	if ($debug >= $level)
	{
		print ("$text");
	}
}

# End of subroutine 'debug_print'





