X-Git-Url: http://git.euphorik.ch/?p=master-thesis.git;a=blobdiff_plain;f=Parasitemia%2FLogger%2FLogger.fs;h=4fc1736412d30bcfc50346698f96219a1c7f992f;hp=cc023141fc895f21318962af8476ae34a867b65e;hb=2d712781def419c9acc98368f7102b19b064f16d;hpb=9343c4deb0bf88c58d9c92d465d8e99f64656875 diff --git a/Parasitemia/Logger/Logger.fs b/Parasitemia/Logger/Logger.fs index cc02314..4fc1736 100644 --- a/Parasitemia/Logger/Logger.fs +++ b/Parasitemia/Logger/Logger.fs @@ -3,34 +3,65 @@ open System open System.Text open System.IO +open System.IO.Compression open System.Diagnostics open System.Threading open System.Collections.Generic -type Severity = DEBUG = 1 | USER = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5 +type Severity = DEBUG = 1 | INFO = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5 -type IListener = abstract NewEntry : Severity -> string -> unit +type IListener = + abstract NewEntry : severity : Severity -> header : string -> message : string -> unit + +type private Message = + { + Message : string + ThreadName : string + ThreadId : int + ModuleCaller : string + Severity : Severity + } + +type private Command = + | Write of Message + | Stop of AsyncReplyChannel [] type Log () = - let maxSizeFile = 10L * 1024L * 1024L // [byte] (10 MB). - let nbEntriesCheckSize = 100; // Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'. - let LogDefaultDirectory = "Parasitemia\\Log" - let filenameFormat = "{0:D4}.log" - let encoding = Encoding.GetEncoding("UTF-8") - let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name + let extractNumberFromLogfilepath (path : string) : int option = + if isNull path then + None + else + let filename = path.Substring (path.LastIndexOf Path.DirectorySeparatorChar + 1) + let filenameWithoutExtension = filename.Remove (filename.IndexOf '.') + match Int32.TryParse filenameWithoutExtension with + | (true, n) -> Some n + | _ -> None + + let [] MAX_SIZE_FILE = 52428800L // [byte] (50 MB). + let [] 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'. + let [] COMPRESS_ARCHIVED_FILES = true + let [] FILENAME_FORMAT = "{0:D4}.log" + let [] COMPRESSED_FILE_POSTFIX = ".gzip" + let encoding = Encoding.GetEncoding "UTF-8" + + let compress (filename : string) = + use inputStream = new FileStream (filename, FileMode.Open, FileAccess.Read) + let filenameCompressed = filename + COMPRESSED_FILE_POSTFIX + use compressedStream = new GZipStream (new FileStream (filenameCompressed, FileMode.Create, FileAccess.Write), CompressionLevel.Optimal) + inputStream.CopyTo compressedStream - let mutable stream: StreamWriter = null + let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name - let mutable logDir: string = null - let mutable absoluteDir: string = null + let mutable stream : StreamWriter = null + let mutable filename : string = null - let mutable nbEntries = 0L + let mutable logDir : string = null - let monitor = Object() + let monitor = Object () - let listeners = List() + let listeners = List () let debug = #if DEBUG @@ -39,132 +70,179 @@ type Log () = false #endif - static let instance = new Log() - - let setLogDirectory (dir: string) = - lock monitor (fun () -> - logDir <- dir - absoluteDir <- Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), logDir) - - if stream <> null - then - stream.Close() - stream <- null + static let instance = new Log () + let openLogFile (entryNumber : int64) = + if not (isNull logDir) then try - if not <| Directory.Exists(absoluteDir) + if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > MAX_SIZE_FILE then - Directory.CreateDirectory(absoluteDir) |> ignore + if not (isNull stream) + then + stream.Close () + if COMPRESS_ARCHIVED_FILES then + 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 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 > MAX_SIZE_FILE + then + filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1)) + with + | :? FileNotFoundException -> () // The file may not exist. + + stream <- new StreamWriter (filename, true, encoding) with - | _ as ex -> Console.Error.WriteLine("Unable to create the log directory: {0}", absoluteDir)) + | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex) - let openLogFile () = - try - if stream = null || (nbEntries % (int64 nbEntriesCheckSize) = 0L) && stream.BaseStream.Length > maxSizeFile - then - if stream <> null - then - stream.Close() + let write (msg : Message) (entryNumber : int64) = + openLogFile entryNumber - let mutable n = 1 - for existingFile in Directory.GetFiles(absoluteDir) do - let current_n = ref 0 - if Int32.TryParse(existingFile.Remove(existingFile.LastIndexOf('.')), current_n) && !current_n > n - then - n <- !current_n + let header = + String.Format ( + "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3})", + TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow, + string msg.Severity, + msg.ModuleCaller, + (if String.IsNullOrEmpty msg.ThreadName then string msg.ThreadId else sprintf "%s-%i" msg.ThreadName msg.ThreadId) + ) - let mutable filename = Path.Combine(absoluteDir, String.Format(filenameFormat, n)) - try - if (FileInfo(filename).Length > maxSizeFile) - then - filename <- Path.Combine(absoluteDir, String.Format(filenameFormat, n + 1)) - with - | :? FileNotFoundException -> () // The file may not exist. + for listener in listeners do + listener.NewEntry msg.Severity header msg.Message - stream <- new StreamWriter(filename, true, encoding) - with - | _ as ex -> Console.Error.WriteLine("Can't open the file log: {0}", ex) + if not (isNull stream) + then + try + stream.WriteLine ("{0} : {1}", header, msg.Message) + stream.Flush () + with + | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex) + + let writeAgent = + new MailboxProcessor ( + fun inbox -> + let rec loop (nbEntries : int64) = + async { + let! command = inbox.Receive () + match command with + | Write message -> + write message nbEntries + return! loop (nbEntries + 1L) + | Stop replyChannel -> + replyChannel.Reply () + } + loop 1L + ) do - setLogDirectory LogDefaultDirectory - - interface IDisposable with - member this.Dispose () = - if stream <> null - then - stream.Dispose() + writeAgent.Start () - member private this.Write (message: string, severity: Severity) = - lock monitor (fun () -> - nbEntries <- nbEntries + 1L - openLogFile () - - if stream <> null - then - let mutable moduleNameCaller = moduleName - match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name - if name <> moduleName then Some name else None) with - | Some name -> moduleNameCaller <- name - | _ -> () + let setLogDirectory (dir : string) = + lock monitor ( + fun () -> + logDir <- dir - let threadName = Thread.CurrentThread.Name - - for listener in listeners do - listener.NewEntry severity message + if not <| isNull stream then + stream.Close () + stream <- null try - stream.WriteLine( - "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3}) : {4}", - TimeZone.CurrentTimeZone.ToLocalTime(DateTime.UtcNow), - severity.ToString(), - moduleNameCaller, - (if String.IsNullOrEmpty(threadName) then Thread.CurrentThread.ManagedThreadId.ToString() else String.Format("{0}-{1}", threadName, Thread.CurrentThread.ManagedThreadId)), - message - ) - stream.Flush() + if not <| Directory.Exists logDir + then + Directory.CreateDirectory logDir |> ignore with - | :? IOException as ex -> Console.Error.WriteLine("Unable to write to the log file: {0}", ex)) + | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir) + ) - - member private this.AddListener (listener: IListener) = - lock monitor (fun () -> - if not <| listeners.Contains(listener) + interface IDisposable with + member this.Dispose () = + if not (isNull stream) then - listeners.Add(listener)) + stream.Dispose () + (writeAgent :> IDisposable).Dispose () + + member private this.Write (message : string) (severity : Severity) = + let moduleNameCaller = + match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name + if name <> moduleName then Some name else None) with + | Some name -> name + | _ -> moduleName + + let command = + Write + { + Message = message + ThreadName = Thread.CurrentThread.Name + ThreadId = Thread.CurrentThread.ManagedThreadId + ModuleCaller = moduleNameCaller + Severity = severity + } + + writeAgent.Post command + + /// + /// Will stop and wait a reply. Used to flush the remaining messages. + /// + member private this.Stop () = + writeAgent.PostAndReply ( + fun replyChannel -> + Stop replyChannel + ) + + member this.LogDirectory + with get () = logDir + and set value = setLogDirectory value + + static member SetLogDirectory (dir : string) = + instance.LogDirectory <- dir + + member this.AddListener (listener : IListener) = + lock monitor ( + fun () -> + if not <| listeners.Contains listener + then + listeners.Add listener + ) - member private this.RmListener (listener: IListener) = - lock monitor (fun () -> - listeners.Remove(listener) |> ignore) + member this.RmListener (listener : IListener) = + lock monitor (fun () -> listeners.Remove listener |> ignore) - static member AddListener (listener: IListener) = instance.AddListener(listener) - static member RmListener (listener: IListener) = instance.RmListener(listener) + static member AddListener (listener : IListener) = instance.AddListener listener + static member RmListener (listener : IListener) = instance.RmListener listener - static member LogWithTime (message: string, severity: Severity, f: unit -> 'a option, [] args: Object[]) : 'a option = - let sw = Stopwatch() - sw.Start() + static member LogWithTime (severity : Severity) (f : unit -> 'a) (format : Printf.StringFormat<'b, 'a>) : 'b = + let sw = Stopwatch () + sw.Start () let res = f () - sw.Stop() - if res.IsSome - then - instance.Write(String.Format(message, args) + sprintf " (time: %d ms)" sw.ElapsedMilliseconds, severity) - res + sw.Stop () + Printf.kprintf (fun s -> instance.Write (s + sprintf " (time: %d ms)" sw.ElapsedMilliseconds) severity; res) format - static member Debug (message: string, [] args: Object[]) = + static member Debug format = #if DEBUG - instance.Write(String.Format(message, args), Severity.DEBUG) + Printf.kprintf (fun s -> instance.Write s Severity.DEBUG) format #else - () + Printf.kprintf (fun _ -> ()) format // TODO: can it be simplify? #endif - static member User (message: string, [] args: Object[]) = - instance.Write(String.Format(message, args), Severity.USER) + static member Info format = + Printf.kprintf (fun s -> instance.Write s Severity.INFO) format - static member Warning (message: string, [] args: Object[]) = - instance.Write(String.Format(message, args), Severity.WARNING) + static member Warning format = + Printf.kprintf (fun s -> instance.Write s Severity.WARNING) format - static member Error (message: string, [] args: Object[]) = - instance.Write(String.Format(message, args), Severity.ERROR) + static member Error format = + Printf.kprintf (fun s -> instance.Write s Severity.ERROR) format - static member Fatal (message: string, [] args: Object[]) = - instance.Write(String.Format(message, args), Severity.FATAL) + static member Fatal format = + Printf.kprintf (fun s -> instance.Write s Severity.FATAL) format + static member Shutdown () = + instance.Stop ()