4 open System.Collections.Generic
12 type internal FileWriter (logDir
: string) =
13 let mutable maxSizeFile = DEFAULT_MAX_SIZE_FILE
14 let mutable stream : StreamWriter = null
15 let mutable filename : string = null
17 let mutable avoidRepeatingIdenticalMessages : bool = false
18 let lastMessageHashes = Queue<int * DateTime> ()
22 if not
<| Directory.Exists logDir then
23 Directory.CreateDirectory logDir |> ignore
25 | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
27 // Open a file to log into. Each file has a number ('entryNumber').
28 let openLogFile (entryNumber
: int64
) =
29 if not
(isNull
logDir) then
31 if isNull
stream || (entryNumber
% (int64
NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > maxSizeFile then
32 if not
(isNull
stream) then
34 if COMPRESS_ARCHIVED_FILES then
35 Utils.compress
filename
38 // Search the last id among the log files.
40 for existingFile
in Directory.GetFiles logDir do
41 match Utils.extractNumberFromLogfilepath existingFile
with
42 | Some n' when n' > n -> n <- n'
45 filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
47 if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || (FileInfo filename).Length > maxSizeFile then
48 filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
50 | :? FileNotFoundException -> () // The file may not exist.
52 let fileStream = File.Open (filename, FileMode.Append, FileAccess.Write, FileShare.Read)
53 stream <- new StreamWriter (fileStream, encoding)
55 | ex -> Console.Error.WriteLine ("Can't
open the file log: {0}
", ex)
57 let write (msg : Message) (entryNumber : int64) =
58 openLogFile entryNumber
60 let header = Utils.formatHeader msg
62 if not <| isNull stream then
64 let writeAndFlush (header : string) (message : string) =
65 stream.WriteLine (Utils.formatMessage header message)
68 if avoidRepeatingIdenticalMessages && msg.Message.Length > Constants.MIN_MESSAGE_LENGTH_TO_NOT_BE_REPEATED then
69 let newMessageHash = hash msg.Message
70 match lastMessageHashes |> Seq.tryPick (fun (hash, dateTime) -> if hash = newMessageHash then Some dateTime else None) with
72 writeAndFlush header (String.Format ("<Same as {0:yyyy
-MM-dd
HH:mm
:ss
.fff
}>", dateTime))
74 lastMessageHashes.Enqueue (hash msg.Message, msg.DateTime)
75 if lastMessageHashes.Count > Constants.MAX_NB_OF_MESSAGE_HASHES_WHEN_AVOIDING_REPEATING_IDENTICAL_MESSAGES then
76 lastMessageHashes.Dequeue () |> ignore
77 writeAndFlush header msg.Message
79 writeAndFlush header msg.Message
81 | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}
", ex)
83 let closeCurrentStream () =
84 if not <| isNull stream then
89 Directory.EnumerateFiles logDir
90 |> Seq.filter (fun file -> FILENAME_PATTERN.IsMatch file || FILENAME_PATTERN_COMPRESSED.IsMatch file)
93 let clearLogFiles (timeOld : TimeSpan) =
96 for file in logFiles () do
97 let fileInfo = FileInfo file
98 if fileInfo.LastWriteTime.Add timeOld <= DateTime.Now then
99 // Special case for 0001.log to keep the file opened in text editor (developer convenience)
100 if fileInfo.Name = String.Format (FILENAME_FORMAT, 1) then
101 File.WriteAllText (file, "")
105 let logInternalErrorMessage (message : string) (entryNumber : int64) =
108 Message = sprintf "Logger internal error: %s
" message
109 ThreadName = Thread.CurrentThread.Name
110 ThreadId = Thread.CurrentThread.ManagedThreadId
111 ModuleCaller = Assembly.GetExecutingAssembly().GetName().Name
112 Severity = Severity.ERROR
113 DateTime = TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow
118 new MailboxProcessor<Command> (
120 let rec loop (nbEntries : int64) =
123 let! command = inbox.Receive ()
126 write message nbEntries
127 return! loop (nbEntries + 1L)
129 | Flush replyChannel ->
130 replyChannel.Reply ()
131 return! loop nbEntries
133 | Shutdown replyChannel ->
134 closeCurrentStream ()
135 replyChannel.Reply ()
137 | ClearLogFilesOlderThan timeOld ->
138 clearLogFiles timeOld
141 | SetAvoidRepeatingIdenticalMessage enabled ->
142 avoidRepeatingIdenticalMessages <- enabled
143 if not avoidRepeatingIdenticalMessages then
144 lastMessageHashes.Clear ()
145 return! loop nbEntries
148 logInternalErrorMessage (string ex) nbEntries
149 return! loop (nbEntries + 1L)
157 interface IWriter with
158 member val DebugLoggingEnabled = false with get, set
160 member this.AvoidRepeatingIdenticalMessages
161 with get () = avoidRepeatingIdenticalMessages
162 and set value = mailbox.Post (SetAvoidRepeatingIdenticalMessage value)
164 member this.LogDir = logDir
166 member this.MaxSizeFile
167 with get () = maxSizeFile
168 and set value = maxSizeFile <- value
170 member this.LogFiles = logFiles ()
172 member this.Write (message : Message) =
173 mailbox.Post (Write message)
175 member this.Flush () =
176 mailbox.PostAndReply (fun replyChannel -> Flush replyChannel)
178 member this.ClearLogFilesOlderThan (timeOld : TimeSpan) =
179 mailbox.Post (ClearLogFilesOlderThan timeOld)
181 interface IDisposable with
182 member this.Dispose () =
183 mailbox.PostAndReply (
185 Shutdown replyChannel
187 (mailbox :> IDisposable).Dispose()