##################
## Module Name     --  outlog.tcl
## Original Author --  Emmanuel Frecon - [email protected]
## Description:
##
##    This module contains commands to dump output to log files in a manner
##    as safe as possible.  The module also handles log rotation.
##
## Commands Exported:
##        outlog_open
##        outlog_puts
##        outlog_close
##################
 
array set __OutLog {
     id_generator    0
     logs            ""
}
 
# Command Name     -- outlog_open
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Create a new log creation object and return a reference to it.
#
# Arguments:
#    logfile        - Name of log file to handle (empty or stdout understood)
#    rotate        - Number of hours before rotating, -1 to switch off
#    keep        - Number of log rotation files to keep
proc outlog_open { logfile { rotate -1 } { keep 4 } } {
     global __OutLog
 
     # Look if there is not an already existing log rotator 
     # for that file.
     foreach id $__OutLog(logs) {
         set varname "__outlog_$id"
         upvar \#0 $varname Log
 
         if { $Log(logfile) == $logfile } {
             set Log(rotate) $rotate
             set Log(keep) $keep
             return  $id
         }
     }
 
     # There is none, initialise an outlog object for that file
     set id [incr __OutLog(id_generator)]
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     set Log(logfile) $logfile
     set Log(accumulator) ""
     if { $logfile == "" || $logfile == "stdout" || $logfile == "-" } {
         set Log(fd) "stdout"
         set Log(start) [clock seconds]
     } else {
         if { [file exists $Log(logfile)] } {
             file stat $Log(logfile) fdata
             set Log(start) $fdata(atime)
         } else {
             set Log(start) [clock seconds]
         }
         set Log(fd) ""
     }
     set Log(rotate) $rotate
     set Log(keep) $keep
 
     lappend __OutLog(logs) $id
     return $id
}

# Command Name     --  outlog_puts
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Log a line to the file associated to an outlog object.  
# Performs log rotation if necessary, applicable and requested.  
# Handle files that might have been lost through NFS restarts...
#
# Arguments:
#    id         - Identifier of outlog object
#    line        - Line to dump to file
#    norotation        - Do not rotate right now if set 
proc outlog_puts { id line { norotation 0 } } {
     global __OutLog
 
     # Check that this is one of our outlog objects.
     set idx [lsearch $__OutLog(logs) $id]
     if { $idx < 0 } {
         return
     }
     
     # Get to the global that contains all necessary information
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     # Record current time.
     set now [clock seconds]
     set dt [clock format $now]
 
     # If the file descriptor is empty (i.e. at start up or after an
     # NFS failure was discovered), try to reopen the file.
     if { $Log(fd) == "" } {
         if { [catch "open $Log(logfile) a+" fd] == 0 } {
             set Log(fd) $fd
         }
     }
 
     # If we have an opened file descriptor to output to, do that,
     # otherwise accumulate until we get back to normal.
     if { $Log(fd) != "" } {
 
         # The accumulator wasn't empty, which means that we have just
         # recovered back to normal.  Dump back the content of the
         # accumulator to the file, together with some recovery
         # message.
         if { $Log(accumulator) != "" } {
             puts $Log(fd) \
                 "RECOVERED at $dt: Reopened $Log(logfile), dumping accumulator"
             foreach l $Log(accumulator) {
                 puts $Log(fd) $l
             }
             set Log(accumulator) ""
         }
 
         # Output the line to the file.
         puts $Log(fd) $line
 
         # Flush output at once.  We catch this and it may fail.  
         # If it fails, enter output accumulation mode.
         if { [catch "flush $Log(fd)"] != 0 } {
             catch "close $Log(fd)"
             set Log(fd) ""
             lappend Log(accumulator) \
                 "ERROR at $dt: Lost connection to $Log(logfile), accumulating"
             lappend Log(accumulator) $line
         }
     } else {
         lappend Log(accumulator) $line
     }
 
 
     # Now takes care of rotations when possible and requested.
     if { $Log(fd) != "" && $Log(fd) != "stdout" && $Log(rotate) >= 0 \
          && ! $norotation } {
         # We need to rotate, enough time has elapsed since start.
         if { [expr $now - $Log(start)] >= [expr int($Log(rotate) * 3600)] } {
             if { [catch "close $Log(fd)"] == 0 } {
                 # Set the file descriptor to be empty, it will be
                 # reopened next time.
                 set Log(fd) ""
 
                 # And performs rotation through renaming the old
                 # existing files.
                 # This assumes that we can access them.
                 if { $Log(keep) > 2 } {
                     for { set i [expr $Log(keep) - 1]} { $i > 0 } \
                         { incr i -1 } {
                             if { [file exists "$Log(logfile).$i"] } {
                                 file rename -force -- \
                                     "$Log(logfile).$i" \
                                     "$Log(logfile).[expr $i + 1]"
                             }
                         }
                 }
 
                 # Finally move or delete the current log file.
                 # It takes position 1 in the ordered list of logs,
                 # alternatively, if we did not wish to keep logs, it
                 # is removed.
                 if { $Log(keep) >= 1 } {
                     file rename -force -- "$Log(logfile)" "$Log(logfile).1"
                 } else {
                     file delete -force -- "$Log(logfile)"
                 }
 
                 # Do not forget to remember that we have rotated and
                 # reinitialise the timer.
                 set Log(start) $now
             } else {
                 # We could not close, write an information to the
                 # file, there is probably something wrong, so we
                 # recurse to benefit from the NFS protection measures.
                 outlog_puts $id \
                     "ERROR at $dt: Cannot close $Log(logfile) for rotation" \
                     1
             }
         }
     }
}
 
# Command Name     --  outlog_close
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Close an outlog object.  Return 0 if the file could not correctly be
# closed.
#
# Arguments:
#    arg1        -
#    arg2        -
proc outlog_close { id } {
     global __OutLog
 
     # Check that this is one of our outlog objects.
     set idx [lsearch $__OutLog(logs) $id]
     if { $idx < 0 } {
         return
     }
     
     # Get to the global that contains all necessary information
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     # Close file and clean up
     set res 0
     if { $Log(fd) != "stdout" } {
         # If the file is an empty string close will fail as we wish it
         # will
         set res [catch "close $Log(fd)"]
     }
     set __OutLog(logs) [lreplace $__OutLog(logs) $idx $idx]
     unset __OutLog
 
     return [expr ! $res]
}