Version 1.0.10
[master-thesis.git] / Parasitemia / Logger / Logger.fs
1 namespace Logger
2
3 open System
4 open System.Text
5 open System.IO
6 open System.IO.Compression
7 open System.Diagnostics
8 open System.Threading
9 open System.Collections.Generic
10
11 type Severity = DEBUG = 1 | INFO = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5
12
13 type IListener =
14 abstract NewEntry : severity : Severity -> header : string -> message : string -> unit
15
16 type private Message =
17 {
18 Message : string
19 ThreadName : string
20 ThreadId : int
21 ModuleCaller : string
22 Severity : Severity
23 }
24
25 type private Command =
26 | Write of Message
27 | Stop of AsyncReplyChannel<unit>
28
29 [<Sealed>]
30 type Log () =
31
32 let extractNumberFromLogfilepath (path : string) : int option =
33 if isNull path then
34 None
35 else
36 let filename = path.Substring(path.LastIndexOf(Path.DirectorySeparatorChar) + 1)
37 let filenameWithoutExtension = filename.Remove(filename.IndexOf('.'))
38 match Int32.TryParse(filenameWithoutExtension) with
39 | (true, n) -> Some n
40 | _ -> None
41
42 let [<Literal>] MAX_SIZE_FILE = 52428800L // [byte] (50 MB).
43 let [<Literal>] NB_ENTRIES_CHECK_SIZE = 100; // Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'.
44 let [<Literal>] COMPRESS_ARCHIVED_FILES = true
45 let [<Literal>] FILENAME_FORMAT = "{0:D4}.log"
46 let [<Literal>] COMPRESSED_FILE_POSTFIX = ".gzip"
47 let encoding = Encoding.GetEncoding("UTF-8")
48
49 let compress (filename : string) =
50 use inputStream = new FileStream(filename, FileMode.Open, FileAccess.Read)
51 let filenameCompressed = filename + COMPRESSED_FILE_POSTFIX
52 use compressedStream = new GZipStream(new FileStream(filenameCompressed, FileMode.Create, FileAccess.Write), CompressionLevel.Optimal)
53 inputStream.CopyTo(compressedStream)
54
55 let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
56
57 let mutable stream : StreamWriter = null
58 let mutable filename : string = null
59
60 let mutable logDir : string = null
61
62 let monitor = Object()
63
64 let listeners = List<IListener>()
65
66 let debug =
67 #if DEBUG
68 true
69 #else
70 false
71 #endif
72
73 static let instance = new Log()
74
75 let openLogFile (entryNumber : int64) =
76 if not (isNull logDir) then
77 try
78 if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > MAX_SIZE_FILE
79 then
80 if not (isNull stream)
81 then
82 stream.Close()
83 if COMPRESS_ARCHIVED_FILES then
84 compress filename
85 File.Delete(filename)
86
87 // Search the last id among the log files.
88 let mutable n = 1
89 for existingFile in Directory.GetFiles(logDir) do
90 match extractNumberFromLogfilepath existingFile with
91 | Some n' when n' > n -> n <- n'
92 | _ -> ()
93
94 filename <- Path.Combine(logDir, String.Format(FILENAME_FORMAT, n))
95 try
96 if File.Exists(filename + COMPRESSED_FILE_POSTFIX) || FileInfo(filename).Length > MAX_SIZE_FILE
97 then
98 filename <- Path.Combine(logDir, String.Format(FILENAME_FORMAT, n + 1))
99 with
100 | :? FileNotFoundException -> () // The file may not exist.
101
102 stream <- new StreamWriter(filename, true, encoding)
103 with
104 | ex -> Console.Error.WriteLine("Can't open the file log: {0}", ex)
105
106 let write (msg : Message) (entryNumber : int64) =
107 openLogFile entryNumber
108
109 let header =
110 String.Format(
111 "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3})",
112 TimeZone.CurrentTimeZone.ToLocalTime(DateTime.UtcNow),
113 string msg.Severity,
114 msg.ModuleCaller,
115 (if String.IsNullOrEmpty(msg.ThreadName) then string msg.ThreadId else sprintf "%s-%i" msg.ThreadName msg.ThreadId)
116 )
117
118 for listener in listeners do
119 listener.NewEntry msg.Severity header msg.Message
120
121 if not (isNull stream)
122 then
123 try
124 stream.WriteLine("{0} : {1}", header, msg.Message)
125 stream.Flush()
126 with
127 | :? IOException as ex -> Console.Error.WriteLine("Unable to write to the log file: {0}", ex)
128
129 let writeAgent =
130 new MailboxProcessor<Command>(
131 fun inbox ->
132 let rec loop (nbEntries : int64) =
133 async {
134 let! command = inbox.Receive()
135 match command with
136 | Write message ->
137 write message nbEntries
138 return! loop (nbEntries + 1L)
139 | Stop replyChannel ->
140 replyChannel.Reply ()
141 }
142 loop 1L
143 )
144
145 do
146 writeAgent.Start()
147
148 let setLogDirectory (dir : string) =
149 lock monitor (fun () ->
150 logDir <- dir
151
152 if not <| isNull stream then
153 stream.Close()
154 stream <- null
155
156 try
157 if not <| Directory.Exists(logDir)
158 then
159 Directory.CreateDirectory(logDir) |> ignore
160 with
161 | _ -> Console.Error.WriteLine("Unable to create the log directory: {0}", logDir))
162
163 interface IDisposable with
164 member this.Dispose () =
165 if not (isNull stream)
166 then
167 stream.Dispose()
168 (writeAgent :> IDisposable).Dispose()
169
170 member private this.Write (message : string) (severity : Severity) =
171 let moduleNameCaller =
172 match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name
173 if name <> moduleName then Some name else None) with
174 | Some name -> name
175 | _ -> moduleName
176
177 let command =
178 Write
179 {
180 Message = message
181 ThreadName = Thread.CurrentThread.Name
182 ThreadId = Thread.CurrentThread.ManagedThreadId
183 ModuleCaller = moduleNameCaller
184 Severity = severity
185 }
186
187 writeAgent.Post command
188
189 /// <summary>
190 /// Will stop and wait a reply. Used to flush the remaining messages.
191 /// </summary>
192 member private this.Stop () =
193 writeAgent.PostAndReply(
194 fun replyChannel ->
195 Stop replyChannel
196 )
197
198 member this.LogDirectory
199 with get () = logDir
200 and set value = setLogDirectory value
201
202 static member SetLogDirectory (dir : string) =
203 instance.LogDirectory <- dir
204
205 member this.AddListener (listener : IListener) =
206 lock monitor (fun () ->
207 if not <| listeners.Contains(listener)
208 then
209 listeners.Add(listener))
210
211 member this.RmListener (listener : IListener) =
212 lock monitor (fun () ->
213 listeners.Remove(listener) |> ignore)
214
215 static member AddListener (listener : IListener) = instance.AddListener(listener)
216 static member RmListener (listener : IListener) = instance.RmListener(listener)
217
218 static member LogWithTime (severity : Severity) (f : unit -> 'a) (format : Printf.StringFormat<'b, 'a>) : 'b =
219 let sw = Stopwatch()
220 sw.Start()
221 let res = f ()
222 sw.Stop()
223 Printf.kprintf (fun s -> instance.Write (s + sprintf " (time: %d ms)" sw.ElapsedMilliseconds) severity; res) format
224
225 static member Debug format =
226 #if DEBUG
227 Printf.kprintf (fun s -> instance.Write s Severity.DEBUG) format
228 #else
229 Printf.kprintf (fun _ -> ()) format // TODO: can it be simplify?
230 #endif
231
232 static member Info format =
233 Printf.kprintf (fun s -> instance.Write s Severity.INFO) format
234
235 static member Warning format =
236 Printf.kprintf (fun s -> instance.Write s Severity.WARNING) format
237
238 static member Error format =
239 Printf.kprintf (fun s -> instance.Write s Severity.ERROR) format
240
241 static member Fatal format =
242 Printf.kprintf (fun s -> instance.Write s Severity.FATAL) format
243
244 static member Shutdown () =
245 instance.Stop()