{ *************************************************************************** }
MODULE mod_handle_logfile ;
{  Created   8-JUN-1989   MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE }
{ *************************************************************************** }
INCLUDE   
  mod_handle_console,
  $FILE_UTILITY,      { from ELN$:RTLOBJECT.OLB                               }
  $GET_MESSAGE_TEXT ; { from ELN$:RTLOBJECT.OLB                               }
{ *************************************************************************** }
EXPORT
  init_logfile,     {PROCEDURE create semaphore and open the log file         }
  close_logfile,    {PROCEDURE close the log file                             }
  write_logfile ;   {PROCEDURE write a line in log file                       }
{ *************************************************************************** }
IMPORT 

  display_console,              {from module MOD_HANDLE_CONSOLE               }

  FILE$ATTRIBUTES_RECORD,
  STATUS$TEXT,STATUS$IDENT,STATUS$SEVERITY,STATUS$FACILITY,
  ELN$GET_STATUS_TEXT ;         {from module $GET_MESSAGE_TEXT                }
{ *************************************************************************** }
{ *************************************************************************** }
CONST

  fixed_length = 132 ;
  line_feed = CHR(10) ;

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

VAR
  disk_io         : SEMAPHORE ;
  file_attributes :^FILE$ATTRIBUTES_RECORD ;
  logfile         : FILE OF STRING(fixed_length) ;
  logfile_opened  : BOOLEAN := FALSE ;
  logfile_name    : VARYING_STRING(50) ;
  no_logfile      : BOOLEAN := TRUE ;
  
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE init_logfile ( name : VARYING_STRING(50) := '' ;
                    buffering : BOOLEAN := TRUE ;
                   VAR status :[OPTIONAL] INTEGER ) ;

VAR ini_status : INTEGER ;                          {general use status buffer}
BEGIN

  IF PRESENT(status) THEN status := 1 ;

{ create and initialize console screen access syncronization semaphore   **** }
  CREATE_SEMAPHORE ( disk_io, 1, 1, STATUS := ini_status ) ;
  IF ( ini_status <> 1 )
  THEN BEGIN
    IF PRESENT(status) THEN status := ini_status ;
    GOTO quit_init_logfile ;
  END ;
     
  IF ( name <> ' ' ) 
  THEN BEGIN 
    logfile_name := name ;
    OPEN ( logfile, FILE_NAME := logfile_name,
                      HISTORY := HISTORY$NEW,      
                RECORD_LENGTH := fixed_length,
               RECORD_LOCKING := TRUE,             
                ACCESS_METHOD := ACCESS$SEQUENTIAL,
                  RECORD_TYPE := RECORD$FIXED,  
             CARRIAGE_CONTROL := CARRIAGE$LIST,    
                  DISPOSITION := DISPOSITION$SAVE, 
                      SHARING := SHARE$READONLY,   
                       APPEND := TRUE,
                    BUFFERING := buffering,
                   BUFFERSIZE := 4096,
                   CONTIGUOUS := FALSE,
                   EXTENDSIZE := 10,
                     FILESIZE := 10,
                     TRUNCATE := TRUE,
              FILE_ATTRIBUTES := file_attributes,
                        OWNER := %O00040001,
                       STATUS := ini_status ) ;
   
    IF ( ( ini_status MOD 8 ) = 1 ) 
    THEN BEGIN
      IF PRESENT(status) THEN status := 1 ;
      logfile_opened := TRUE ;
      no_logfile     := FALSE ;
      write_logfile ( TIME := inline_time_now, 
                   MESSAGE := ' TRICS V' + version_number
                            + ' CREATED LOGFILE, ' + logfile_name ) ;
      write_logfile ;
    END 
    ELSE BEGIN
      no_logfile := TRUE ;
      IF PRESENT(status) THEN status := ini_status ;
      GOTO quit_init_logfile ;
    END ;
  END 
  ELSE no_logfile := TRUE ;  

quit_init_logfile :
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE reopen_logfile ( name : VARYING_STRING(50) := '' ) ;

VAR 
  open_status : INTEGER ; 
BEGIN

  IF ( name <> ' ' ) THEN logfile_name := name ;

  OPEN ( logfile, FILE_NAME := logfile_name,
                    HISTORY := HISTORY$OLD,      
             RECORD_LOCKING := TRUE,             
                DISPOSITION := DISPOSITION$SAVE, 
                    SHARING := SHARE$READONLY,
                     APPEND := TRUE,
                  BUFFERING := TRUE,
                 BUFFERSIZE := 4096,
                 EXTENDSIZE := 10,
                   TRUNCATE := TRUE,
            FILE_ATTRIBUTES := file_attributes,
                     STATUS := open_status ) ;
   
    IF ( ( open_status MOD 8 ) = 1 ) 
    THEN BEGIN
      logfile_opened := TRUE ;
      no_logfile     := FALSE ;
    END 
    ELSE BEGIN
      display_console ( line_feed + 'reopen_log_file' 
                                  + sys_message(open_status) ) ;
      no_logfile := TRUE ;
    END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE close_logfile ;

VAR status, result : INTEGER ;

BEGIN

  IF ( logfile_opened = TRUE )
  THEN BEGIN

    write_logfile ( TIME := inline_time_now, 
                 MESSAGE := ' TRICS V' + version_number
                          + ' CLOSED LOGFILE, ' + logfile_name ) ;
  
    WAIT_ANY ( disk_io, TIME := -100000000,                       { 10s timeout }
               RESULT := result, STATUS := status ) ;
    IF ( result = 0 ) 
    THEN BEGIN
      display_console ( line_feed + 'WRITE-wait_for_semaphore(disk) 10s timeout ' ) ;
      no_logfile := TRUE ;
    END ;
    IF ( status <> 1 )
    THEN display_console ( line_feed + 'CLOSE-wait_for_semaphore(disk) ' + sys_message(status) ) ;
  
    CLOSE ( logfile ) ;
    logfile_opened := FALSE ;
  
    SIGNAL ( disk_io, STATUS := status  ) ;
    IF ( status <> 1 )
    THEN display_console ( line_feed + 'CLOSE-signal_semaphore(disk) ' + sys_message(status) ) ;

  END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE write_logfile ( message : STRING(fixed_length) := ' ' ;
                             time : STRING(23) := ' ' ) ;
VAR status, result : INTEGER ;
BEGIN

  IF ( no_logfile = TRUE ) THEN GOTO quit_writing_logfile ;

  IF ( time <> ' ' )
  THEN BEGIN
    SUBSTR(message,101, 8) := '%% time:' ;
    SUBSTR(message,110,23) := time ;
  END ;

  WAIT_ANY ( disk_io, TIME := -100000000,                       { 10s timeout }
             RESULT := result, STATUS := status ) ;
  IF ( result = 0 ) 
  THEN BEGIN
    display_console ( line_feed + 'WRITE-wait_for_semaphore(disk) 10s timeout ' ) ;
    no_logfile := TRUE ;
    GOTO quit_writing_logfile ;
  END ;
  IF ( status <> 1 )
  THEN display_console ( line_feed + 'WRITE-wait_for_semaphore(disk) ' + sys_message(status) ) ;

  IF ( logfile_opened = FALSE ) 
  THEN BEGIN
    reopen_logfile ( NAME := logfile_name ) ; 
    IF ( no_logfile = TRUE ) THEN GOTO quit_writing_logfile ;
  END ;

  logfile^ := message ; {12-JUL-1991 change WRITE into PUT }
  PUT ( logfile ) ;     {because WRITE doesn't use record locking }

  SIGNAL ( disk_io, STATUS := status  ) ;
  IF ( status <> 1 )
  THEN display_console ( line_feed + 'WRITE-signal_semaphore(disk) ' + sys_message(status) ) ;

quit_writing_logfile :
END ;
{ *************************************************************************** }
{ *************************************************************************** }
FUNCTION sys_message ( status_to_decode : INTEGER ) : VARYING_STRING(255) ;

VAR   decoded_stat : VARYING_STRING(255) ;
BEGIN

  ELN$GET_STATUS_TEXT ( status_to_decode,
     [STATUS$TEXT,STATUS$IDENT,STATUS$SEVERITY,STATUS$FACILITY], decoded_stat);
  sys_message := decoded_stat ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
[INLINE] FUNCTION inline_time_now : STRING(23) ;
VAR 
  status      : INTEGER ;
  bin_time    : LARGE_INTEGER ;
  ascii_time  : STRING(23) ;
BEGIN
  GET_TIME ( bin_time, STATUS := status ) ;
  IF ( STATUS <> 1 )
  THEN ascii_time := ''
  ELSE ascii_time := TIME_STRING(bin_time) ;
  IF ( SUBSTR(ascii_time,1,1) = ' ' ) THEN SUBSTR(ascii_time,1,1) := '0' ;
  inline_time_now := ascii_time ;
END ;
{ *************************************************************************** }
{ *************************************************************************** }
END.