# ---------------------------------------------------------------------------
# 
# File:    OPC.pm ( - OutPutControl )
#
# Copyright (c) Programming Research, 2004.
#
# Written: C.Waddingham 20-Aug-04
#
# Version: 1.0
#
# Purpose: To provide text output facilities for QAW.
#
# History:
#
# ---------------------------------------------------------------------------

package OPC; #===============================================================

require GEN;

require Exporter;
our @ISA = qw( Exporter );

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

BEGIN
{
   use strict;

   #-- Default setting for progress log output
   #
   # This is modified by SET_PLOG_SELECTED( true / false );
   # It is read by GET_PLOG_SELECTED();
   #
   our $plog_selected = 0;

   #-- Global buffer for PLOG output
   #
   our $plog_buffer = "";

   # Following control output of messages by
   # PUT_MSG_LINE() and
   # PUT_ERR_LINE()
   #
   our $msg_use_stdout = 1;   # true  - default, overridden by SET_MESSAGE_LOGGING_PARAMETERS()
   our $msg_use_stderr = 0;   # false - default, overridden by SET_MESSAGE_LOGGING_PARAMETERS()
   our $err_use_stdout = 0;   # false - default, overridden by SET_ERROR_LOGGING_PARAMETERS()
   our $err_use_stderr = 1;   # true  - default, overridden by SET_ERROR_LOGGING_PARAMETERS()

   # Following flag only set by SET_MESSAGE_LOGGING_PARAMETERS().
   # Read by PUT_MSG_LINE() and CLOSE_LOG_FILES()
   #
   our $msg_use_file;   # boolean.  Deliberately unset.

   # Following flag only set by SET_ERROR_LOGGING_PARAMETERS().
   # Read by PUT_ERR_LINE() and CLOSE_LOG_FILES()
   #
   our $err_use_file;   # boolean.  Deliberately unset.
}

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

sub SET_PLOG_SELECTED
{
   # Usage: SET_PLOG_SELECTED( exists $$hr_qaw_options{ "-plog" } );
   #
   # $plog_selected is a boolean, which is true if '-plog' was specified on
   # the command line.
   #
   $plog_selected = shift;
}

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

sub GET_PLOG_SELECTED
{
   return $plog_selected;
}

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

sub SHOW_PLOG
{
   if ( GET_PLOG_SELECTED() )
   {
      PUT_MSG( GET_PLOG_BUFFER() );
   }
}

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

sub INITIALISE_PLOG_BUFFER
{
   $plog_buffer = "";
}

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

sub GET_PLOG_BUFFER
{
   return $plog_buffer;
}

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

sub PLOG
{
   my $arg = shift;

   $plog_buffer .= $arg;
}

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

sub SET_MESSAGE_LOGGING_PARAMETERS
{
   # Usage: SET_MESSAGE_LOGGING_PARAMETERS( $$hr_qaw_options{ "-logmsgs" } );
   #
   # Note $msg_settings ::= [ 'STDOUT' ][ 'STDERR' ][ 'FILE' ]
   #
   my $msg_settings = shift;

   if ( ! defined( $msg_settings ) )
   {
      return;
   }

   $msg_use_stdout = ( $msg_settings =~ /\bSTDOUT\b/oi );

   $msg_use_stderr = ( $msg_settings =~ /\bSTDERR\b/oi );
   
   if ( $msg_settings =~ /\bFILE\b/oi )
   {
      my $filename = lc( PARAM::EXECUTABLE_NAME() ) . "_msg.log";

      my $open_ok = open MSGLOGFILE, ">$filename";
   
      if ( $open_ok )
      {
   	 $msg_use_file = 1;  # true
      }
      else
      {
   	 GEN::DIE( ": Cannot open file \"$filename\"\n$!" );
      }
   }
}

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

sub SET_ERROR_LOGGING_PARAMETERS
{
   # Usage: SET_ERROR_LOGGING_PARAMETERS( $$hr_qaw_options{ "-logerrs" } );
   #
   # Note $err_settings ::= [ 'STDOUT' ][ 'STDERR' ][ 'FILE' ]
   #
   my $err_settings = shift;

   if ( ! defined( $err_settings ) )
   {
      return;
   }

   $err_use_stdout = ( $err_settings =~ /\bSTDOUT\b/oi );

   $err_use_stderr = ( $err_settings =~ /\bSTDERR\b/oi );
   
   if ( $err_settings =~ /\bFILE\b/oi )
   {
      my $filename = lc( PARAM::EXECUTABLE_NAME() ) . "_err.log";

      my $open_ok = open ERRLOGFILE, ">$filename";
   
      if ( $open_ok )
      {
   	 $err_use_file = 1;  # true
      }
      else
      {
   	 GEN::DIE( ": Cannot open file \"$filename\"\n$!" );
      }
   }

   # Override current GEN::DIE output parameters to match OPC::PUT_ERR_LINE()
   #
   GEN::SET_DIE_STDOUT( $err_use_stdout );
   GEN::SET_DIE_STDERR( $err_use_stderr );
}

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

sub CLOSE_LOG_FILES
{
   # Usage: OPEN_LOG_FILE( $filename )
   #
   # Close file written to by PUT_MSG_LINE() and PUT_ERR_LINE().
   #

   if ( $err_use_file )
   {
      close ERRLOGFILE;
   }

   $err_use_file = 0;

   if ( $msg_use_file )
   {
      close MSGLOGFILE;
   }

   $msg_use_file = 0;
}

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

sub PUT_MSG_LINE
{
   # Usage: PUT_MSG_LINE( $message );
   #
   # Optionally prints $message to STDOUT | STDERR | LOGFILE
   #
   # With "\n" appended.
   #
   my $message = shift;

   PUT_MSG( $message . "\n" );
}

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

sub PUT_MSG
{
   # Usage: PUT_MSG( $message );
   #
   # Optionally prints $message to STDOUT | STDERR | LOGFILE
   #
   my $message = shift;

   if ( $msg_use_stdout )
   {
      GEN::PRINT_STDOUT( $message );
   }

   if ( $msg_use_stderr )
   {
      GEN::PRINT_STDERR( $message );
   }

   # Note PUT_MSG_LINE and PUT_ERR_LINE log output to the same file 
   # (if enabled).
   #
   if ( $msg_use_file )
   {
      print MSGLOGFILE $message;
   }
}

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

sub PUT_ERR_LINE
{
   # Usage: PUT_ERR_LINE( $error_message );
   #
   # Optionally prints $error_message to STDOUT | STDERR | LOGFILE
   #
   # With "ERROR: " prefix and "\n" appended.
   #
   my $error_message = shift;

   PUT_ERR( "ERROR: $error_message\n" );
}

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

sub PUT_ERR
{
   # Usage: PUT_ERR( $error_message );
   #
   # Optionally prints $error_message to STDOUT | STDERR | LOGFILE
   #
   my $error_message = shift;

   if ( $err_use_stdout )
   {
      GEN::PRINT_STDOUT( $error_message );
   }

   if ( $err_use_stderr )
   {
      GEN::PRINT_STDERR( $error_message );
   }

   # Note PUT_MSG_LINE and PUT_ERR_LINE log output to the same file 
   # (if enabled).
   #
   if ( $err_use_file )
   {
      print ERRLOGFILE $error_message;
   }
}

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

sub LOG_ERROR
{
   # Usage: LOG_ERROR( $msg,
   #                   $return_code,
   #                   $file_name,
   #                   $error_logged,
   #                   $code_recognised );
   #
   my $msg             = shift;
   my $return_code     = shift;
   my $file_name       = shift;
   my $error_logged    = shift;
   my $code_recognised = shift;

   my $logging_selected = GET_PLOG_SELECTED();

   if ( $logging_selected )
   {
      if ( $error_logged )
      {
         PLOG( $msg . "\n\n" );
      }
      else
      {
         PLOG( GEN::TIME() . " " . $msg . "\n\n" );
      }
   }
   else
   {
      if ( $code_recognised eq "<KNOWN CODE>" )
      {
         # Check whether already mentioned the return code:
         #
         if ( $msg =~ /returns? code/oi )
         {
            # Here when return code already mentioned
            # So don't display again.
            #
      	    PUT_ERR_LINE
   	       ( PARAM::QA_PROGRAM() .
   	         " analysis of \"$file_name\" - $msg." );
	 }
         else
         {
	    PUT_ERR_LINE
               ( PARAM::QA_PROGRAM() .
		 " analysis of \"$file_name\" - $msg.  " .
		 "Return code = $return_code" );
         }
      }
      else
      {
   	 PUT_ERR_LINE( $msg );
      }
   }
}

# -- eof OPC.pm -------------------------------------------------------------
