--- /dev/null
+namespace Logger
+
+open System
+open System.Collections.Generic
+open System.IO
+open System.Reflection
+open System.Threading
+
+open Logger.Constants
+open Logger.Types
+
+type internal FileWriter (logDir : string) =
+ let mutable maxSizeFile = DEFAULT_MAX_SIZE_FILE
+ let mutable stream : StreamWriter = null
+ let mutable filename : string = null
+
+ let mutable avoidRepeatingIdenticalMessages : bool = false
+ let lastMessageHashes = Queue<int * DateTime> ()
+
+ do
+ try
+ if not <| Directory.Exists logDir then
+ Directory.CreateDirectory logDir |> ignore
+ with
+ | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
+
+ // Open a file to log into. Each file has a number ('entryNumber').
+ let openLogFile (entryNumber : int64) =
+ if not (isNull logDir) then
+ try
+ if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > maxSizeFile then
+ if not (isNull stream) then
+ stream.Close ()
+ if COMPRESS_ARCHIVED_FILES then
+ Utils.compress filename
+ File.Delete filename
+
+ // Search the last id among the log files.
+ let mutable n = 1
+ for existingFile in Directory.GetFiles logDir do
+ match Utils.extractNumberFromLogfilepath existingFile with
+ | Some n' when n' > n -> n <- n'
+ | _ -> ()
+
+ filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
+ try
+ if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || (FileInfo filename).Length > maxSizeFile then
+ filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
+ with
+ | :? FileNotFoundException -> () // The file may not exist.
+
+ let fileStream = File.Open (filename, FileMode.Append, FileAccess.Write, FileShare.Read)
+ stream <- new StreamWriter (fileStream, encoding)
+ with
+ | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex)
+
+ let write (msg : Message) (entryNumber : int64) =
+ openLogFile entryNumber
+
+ let header = Utils.formatHeader msg
+
+ if not <| isNull stream then
+ try
+ let writeAndFlush (header : string) (message : string) =
+ stream.WriteLine (Utils.formatMessage header message)
+ stream.Flush ()
+
+ if avoidRepeatingIdenticalMessages && msg.Message.Length > Constants.MIN_MESSAGE_LENGTH_TO_NOT_BE_REPEATED then
+ let newMessageHash = hash msg.Message
+ match lastMessageHashes |> Seq.tryPick (fun (hash, dateTime) -> if hash = newMessageHash then Some dateTime else None) with
+ | Some dateTime ->
+ writeAndFlush header (String.Format ("<Same as {0:yyyy-MM-dd HH:mm:ss.fff}>", dateTime))
+ | None ->
+ lastMessageHashes.Enqueue (hash msg.Message, msg.DateTime)
+ if lastMessageHashes.Count > Constants.MAX_NB_OF_MESSAGE_HASHES_WHEN_AVOIDING_REPEATING_IDENTICAL_MESSAGES then
+ lastMessageHashes.Dequeue () |> ignore
+ writeAndFlush header msg.Message
+ else
+ writeAndFlush header msg.Message
+ with
+ | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex)
+
+ let closeCurrentStream () =
+ if not <| isNull stream then
+ stream.Dispose ()
+ stream <- null
+
+ let logFiles () =
+ Directory.EnumerateFiles logDir
+ |> Seq.filter (fun file -> FILENAME_PATTERN.IsMatch file || FILENAME_PATTERN_COMPRESSED.IsMatch file)
+ |> Seq.sort
+
+ let clearLogFiles (timeOld : TimeSpan) =
+ closeCurrentStream ()
+
+ for file in logFiles () do
+ let fileInfo = FileInfo file
+ if fileInfo.LastWriteTime.Add timeOld <= DateTime.Now then
+ // Special case for 0001.log to keep the file opened in text editor (developer convenience)
+ if fileInfo.Name = String.Format (FILENAME_FORMAT, 1) then
+ File.WriteAllText (file, "")
+ else
+ fileInfo.Delete ()
+
+ let logInternalErrorMessage (message : string) (entryNumber : int64) =
+ write
+ {
+ Message = sprintf "Logger internal error: %s" message
+ ThreadName = Thread.CurrentThread.Name
+ ThreadId = Thread.CurrentThread.ManagedThreadId
+ ModuleCaller = Assembly.GetExecutingAssembly().GetName().Name
+ Severity = Severity.ERROR
+ DateTime = TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow
+ }
+ entryNumber
+
+ let mailbox =
+ new MailboxProcessor<Command> (
+ fun inbox ->
+ let rec loop (nbEntries : int64) =
+ async {
+ try
+ let! command = inbox.Receive ()
+ match command with
+ | Write message ->
+ write message nbEntries
+ return! loop (nbEntries + 1L)
+
+ | Flush replyChannel ->
+ replyChannel.Reply ()
+ return! loop nbEntries
+
+ | Shutdown replyChannel ->
+ closeCurrentStream ()
+ replyChannel.Reply ()
+
+ | ClearLogFilesOlderThan timeOld ->
+ clearLogFiles timeOld
+ return! loop 1L
+
+ | SetAvoidRepeatingIdenticalMessage enabled ->
+ avoidRepeatingIdenticalMessages <- enabled
+ if not avoidRepeatingIdenticalMessages then
+ lastMessageHashes.Clear ()
+ return! loop nbEntries
+ with
+ | ex ->
+ logInternalErrorMessage (string ex) nbEntries
+ return! loop (nbEntries + 1L)
+ }
+ loop 1L
+ )
+
+ do
+ mailbox.Start ()
+
+ interface IWriter with
+ member val DebugLoggingEnabled = false with get, set
+
+ member this.AvoidRepeatingIdenticalMessages
+ with get () = avoidRepeatingIdenticalMessages
+ and set value = mailbox.Post (SetAvoidRepeatingIdenticalMessage value)
+
+ member this.LogDir = logDir
+
+ member this.MaxSizeFile
+ with get () = maxSizeFile
+ and set value = maxSizeFile <- value
+
+ member this.LogFiles = logFiles ()
+
+ member this.Write (message : Message) =
+ mailbox.Post (Write message)
+
+ member this.Flush () =
+ mailbox.PostAndReply (fun replyChannel -> Flush replyChannel)
+
+ member this.ClearLogFilesOlderThan (timeOld : TimeSpan) =
+ mailbox.Post (ClearLogFilesOlderThan timeOld)
+
+ interface IDisposable with
+ member this.Dispose () =
+ mailbox.PostAndReply (
+ fun replyChannel ->
+ Shutdown replyChannel
+ )
+ (mailbox :> IDisposable).Dispose()
\ No newline at end of file
projects / master-thesis.git / blobdiff