# log.icn: Error logging object functions.
#--

$ifndef __LOG_ICN__
$define __LOG_ICN__

$define  LOG_REVISION   "$Revision: 1.3 $"
$define  LOG_DATE       "$Date: 1997/07/12 22:33:24 $"

#================================================================
# Class Log:  Each instance manages a stream of error messages,
# so that:
#   1.  Multiple contributions to the error stream are merged.
#   2.  A unified error count is maintained for each error type.
#   3.  A separate log file will contain an echo of everything
#       sent to &errout (although this is not mandatory), but
#       the log file will not persist unless it records at
#       least one error.
#----------------------------------------------------------------
# Exported methods
#----------------------------------------------------------------
# Log_Open ( fileName, prefix )
#   [ if fileName is a string or &null, and 
#     prefix is &null or a nonempty string ->
#       if fileName is &null or the name of a file that can be
#       opened for writing ->
#         return a new Log object, logging to &errout, and also to
#         fileName if given, and using eff-prefix(prefix) as the
#         error message prefix
#       else ->
#         &errout  :=  a message about how we can't open (fileName)
#         return a new Log object, logging to &errout, and using
#         eff-prefix(prefix) as the error message prefix
#   ]
#--
# Log_Error ( self, text, ... )
#   [ if the (text) arguments are all strings ->
#       self  ||:=  an error of the default kind, prefixed by self's
#                   prefix, whose text is made from all the (text) arguments
#       fail
#   ]
#--
# Log_Error_Count ( self, errKind )
#   [ returns the number of times Log_Error() has been called on self
#     with kind (errKind, defaulting to DEFAULT_ERR_KIND), as an integer
#   ]
#--
# Log_Error_Kind ( self, errKind, text, ... )
#   [ if (errKind) is &null or a string, and all the (text) arguments
#     are strings ->
#       self  ||:=  an error of kind (errKind, defaulting to
#                   DEFAULT_ERR_KIND), prefixed by self's prefix,
#                   whose message is the concatenation of all the
#                   (text) arguments
#       fail
#   ]
#--
# Log_Fatal ( self, text, ... )
#   [ if the (text) arguments are all strings ->
#       self  ||:=  an error message with self's prefix, made from
#                   the concatenation of the (text) arguments
#       stop execution with error code 1
#   ]
#--
# Log_Message ( log, text, ... )
#   [ if the (text) arguments are all strings ->
#       self  ||:=  a message (not considered an error), prefixed
#                   with self's prefix, made from the concatenation
#                   of the (text) arguments
#   ]
# Note: For multi-line error messages, use Log_Error[_Kind]() for
# the first line and Log_Message() for the remaining lines, so it
# will be counted as only one error.
#--
# Log_Write ( self, text, ... )
#   [ if the (text) arguments are all strings ->
#       self  ||:=  a message (not considered an error), with no
#                   prefix, and made from the concatenation of the
#                   (text) arguments
#   ]
# Note: Log_Message() starts the line with the standard prefix,
# while Log_Write() sends the text out unadorned.
#--
# Log_Close ( self )
#   [ if Log_Error_Count(self) is nonzero ->
#       fails
#     else ->
#       returns &null
#     In any case ->
#       self  :=  self with the log file (if any) closed
#   ]
#--
#   Log_Version ( )
#   [ returns a string that identifies the version and date of
#     this Log object
#   ]
#--


# - - - - -   State   - - - - -

  record logTag (       # State for the log object
    logFile,            # File handle for the log file, if any
    prefix,             # String to be prefixed to all messages
    kindMap )           # Table: maps errKind -> integer error count


# - - - - -   Invariants   - - - - -


#--
# kindMap is a table, with a &null default element, such that
# kindMap[K] === N, where N is the number of errors of type K
# that have been sent to self
#--


# - - - - -   Definitions   - - - - -

#--
# dest(log) ==
#   if log.logFile is defined ->
#     (&errout, log.logFile)
#   else ->
#     (&errout)
#--
# eff-prefix(prefix) ==
#   if (prefix) is &null -> DEFAULT_PREFIX
#   else -> (prefix)
#--


# - - - - -   Revision history   - - - - -

#--
# 1996-09-24: Rework appearance.
#--
# 1995-11-01: Add intended functions for Cleanroom verification.
#--
# 1995-10-18: Add `prefix' argument to Log_Open.  This allows
#   multiple streams to be combined, with prefixes (default value
#   DEFAULT_PREFIX) to distinguish them.
#--
# 1995-08-19: Start design.  This object arose as a third level
#   of design explosion---I was working on the taxonomy object,
#   then I realized that iscan.icn needed to be redone as an
#   object, then I decided that the error-logging stuff needed
#   to be removed from iscan.icn.
#--


# - - - - -   Defines   - - - - -

$define  DEFAULT_ERR_KIND   "Error"     # Default errKind
$define  DEFAULT_PREFIX     "*** "      # Default prefix


# - - -   L o g _ O p e n   - - -

procedure Log_Open ( fileName, prefix )
  local self        # The Log object to be returned

  #-- 1 --
  #-[ self  :=  a new logTag record with fields:
  #     .logFile      :=  &null
  #     .kindMap      :=  an empty table
  #     .prefix       :=  eff-prefix(prefix)
  #-]
  self              :=  logTag ( );
  self.kindMap      :=  table ( );
  self.prefix       :=  ( \ prefix ) | DEFAULT_PREFIX;

  #-- 2 --
  #-[ if fileName is &null -> I
  # | else if fileName can be opened for writing ->
  #     self.logFile  :=  writable file handle pointing at fileName
  # | else ->
  #     dest(self)    ||:=  error message, can't open (fileName)
  #-]
  if  \ fileName  then
  { #-- Open the log file
    if  not ( self.logFile := open ( fileName, "w" ) )  then
    { #-- Couldn't open the self file.  Bitch, but proceed.
      Log_Error ( self, "Could not open the error log file `",
                  fileName, "'." );
    } #-- Couldn't open the log file.
  } #-- Open the log file

  #-- 3 --
  #-[ return the log object ]
  return self;
end # --- Log_Open ---


# - - -   L o g _ E r r o r   - - -

#-[ dest(self)  :=    self with one additional error count of class
#                     DEFAULT_ERR_KIND
#   &errout     ||:=  self.prefix || DEFAULT_ERR_KIND || ": " ||
#                     concatenation of all strings from L
#   fail
#-]

procedure Log_Error ( self, L[] )
#--
# Sends the 2nd argument and all successive arguments to self,
# with "Error" as the error kind.
#--
  local text

  text  :=  "";
  every  text  ||:=  ! L;       # Build up the error text
  return Log_Error_Kind ( self, DEFAULT_ERR_KIND, text );
end # --- Log_Error ---


# - - -   L o g _ E r r o r _ K i n d   - - -

#-[ if errKind is &null ->
#     self        :=    self with one additional error count of class
#                       DEFAULT_ERR_KIND
#     dest(self)  ||:=  self.prefix || DEFAULT_ERR_KIND || ": " ||
#                      concatenation of all strings from L
# | else ->
#     self        :=    self with one additional error count of class
#                       errKind
#     dest(self)  ||:=  self.prefix || errKind || ": " ||
#                       concatenation of all strings from L
# | In any case ->
#     fail
#-]

procedure Log_Error_Kind ( self, errKind, L[] )
#--
# Log an error of type `errKind' (which defaults to DEFAULT_ERR_KIND).
#--
  local text

  text  :=  "";
  every  text ||:= ! L;                 # Concatenate text strings

  / errKind  :=  DEFAULT_ERR_KIND;      # Default the errKind value
  / self.kindMap[errKind]  :=   0;      # Clear the count, if a new kind
  self.kindMap[errKind]    +:=  1;      # Increment the count for this kind

  Log_Message ( self, errKind, ": ", text );
  fail;
end # --- Log_Error_Kind ---


# - - -   L o g _ E r r o r _ C o u n t   - - -

#-[ if errKind is &null ->
#     return the count of errors of class DEFAULT_ERR_KIND
# | else ->
#     return the count of errors of class errKind
#-]

procedure Log_Error_Count ( self, errKind )
#--
# Return the count of calls to Log_Error in which the `errKind'
# value matches the given value.  Return 0 if there never were
# any.
#--
  / errKind  :=  DEFAULT_ERR_KIND;      # Default the errKind value
  return ( \ self.kindMap[errKind] ) | 0;
end # --- Log_Error_Count ---


# - - -   L o g _ F a t a l   - - -

#-[ dest(self)  ||:=  self.prefix || "Fatal error: " || concatenation of
#                     all strings from L
#   exit with error code 1
#-]

procedure Log_Fatal ( self, L[] )
  local text

  text  :=  "";
  every  text ||:= ! L;

  Log_Error_Kind ( self, "Fatal error", text );
  exit ( 1 );
end # --- Log_Fatal ---


# - - -   L o g _ M e s s a g e   - - -

#-[ if self.logFile is not &null ->
#     self.logFile  ||:=  self.prefix || concatenation of strings from L
# | In any case ->
#     &errout  ||:=  self.prefix || concatenation of strings from L
#-]

procedure Log_Message ( self, L[] )
#--
# Prepend self.prefix to the text from the 2nd and succeeding arguments,
# send it to &errout, and also send it to the log file, if there is one.
#--
  local text

  text  :=  ( \ self.prefix ) | "";
  every  text ||:= ! L;         # Build up all the text

  Log_Write ( self, text );
  return;
end # --- Log_Message ---


# - - -   L o g _ W r i t e   - - -

#-[ if self.logFile is not &null ->
#     self.logFile  ||:=  concatenation of strings from L
# | In any case ->
#     &errout  ||:=  concatenation of strings from L
#-]

procedure Log_Write ( self, L[] )
  local text

  text  :=  "";
  every  text ||:= ! L;         # Build up all the text

  write ( &errout, text );
  write ( \ self.logFile, text );

  return;
end # --- Log_Write ---


# - - -   L o g _ C l o s e   - - -

#-[ if self.logFile is &null -> I
# | else ->
#     close self.logFile
#     self.logFile  :=  &null
#-]

procedure Log_Close ( self )
  close ( \ self.logFile );
  self.logFile  :=  &null;
  return;
end # --- Log_Close ---


# - - -   L o g _ V e r s i o n   - - -

#-[ returns our version identifier
#-]

procedure Log_Version ( )
  return "Log " || LOG_REVISION || " " || LOG_DATE;
end # --- Log_Version ---

$endif