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<unit>
[<Sealed>]
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 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 [<Literal>] MAX_SIZE_FILE = 52428800L // [byte] (50 MB).
+ 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'.
+ let [<Literal>] COMPRESS_ARCHIVED_FILES = true
+ let [<Literal>] FILENAME_FORMAT = "{0:D4}.log"
+ let [<Literal>] 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 moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
let mutable stream : StreamWriter = null
+ let mutable filename : string = null
let mutable logDir : string = null
- let mutable absoluteDir : string = null
- let mutable nbEntries = 0L
+ let monitor = Object ()
- let monitor = Object()
-
- let listeners = List<IListener>()
+ let listeners = List<IListener> ()
let debug =
#if DEBUG
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) then
- Directory.CreateDirectory(absoluteDir) |> ignore
+ if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > MAX_SIZE_FILE
+ then
+ 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<Command> (
+ 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
+ writeAgent.Start ()
- interface IDisposable with
- member this.Dispose () =
- if stream <> null then
- stream.Dispose()
-
- 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 threadName = Thread.CurrentThread.Name
+ let setLogDirectory (dir : string) =
+ lock monitor (
+ fun () ->
+ logDir <- dir
- 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) then
- listeners.Add(listener))
-
- member private 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 LogWithTime (message : string, severity : Severity, f : unit -> 'a option, [<ParamArray>] args: Object[]) : 'a option =
- let sw = Stopwatch()
- sw.Start()
+ interface IDisposable with
+ member this.Dispose () =
+ if not (isNull stream)
+ then
+ 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
+
+ /// <summary>
+ /// Will stop and wait a reply. Used to flush the remaining messages.
+ /// </summary>
+ 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 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 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, [<ParamArray>] 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, [<ParamArray>] 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, [<ParamArray>] 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, [<ParamArray>] 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, [<ParamArray>] 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 ()
projects / master-thesis.git / blobdiff