# Module:         poLog
# Copyright:      Paul Obermeier 2000-2025 / paul@poSoft.de
# First Version:  2000 / 03 / 20
#
# Distributed under BSD license.
#
# Module for logging information.

namespace eval poLog {
    variable ns [namespace current]

    namespace ensemble create

    namespace export Init
    namespace export PrintCallstack
    namespace export GetShowConsole SetShowConsole
    namespace export GetDebugLevels SetDebugLevels
    namespace export GetDebugFile SetDebugFile
    namespace export Info Warning Error Debug
    namespace export LevelOff LevelInfo LevelWarning LevelError LevelDebug
    namespace export Test

    proc Init {} {
        # Public variables.
        variable levelOff       0
        variable levelInfo      1
        variable levelWarning   2
        variable levelError     3
        variable levelDebug     4

        # Private variables.
        variable debugLevels
        variable debugFp
        variable debugFile
        variable debugFileOpen
        variable levelOff
        variable isInititialized

        if { ! [info exists isInititialized] } {
            SetDebugLevels [list $levelOff]
            SetShowConsole 0
            SetDebugFile ""
            set debugFileOpen false
            set debugFp stdout
            set isInititialized true
        }
    }

    proc PrintCallstack { args } {
        set opts [dict create \
            -frames   -1 \
            -maxchars -1 \
            -message  "" \
        ]

        foreach { key value } $args {
            if { [dict exists $opts $key] } {
                if { $value eq "" } {
                    error "PrintCallstack: No value specified for key \"$key\"."
                }
                dict set opts $key $value
            } else {
                error "PrintCallstack: Unknown option \"$key\" specified."
            }
        }

        set numFrames [info frame]
        puts -nonewline "Callstack has [expr {$numFrames - 2}] frames"
        if { [dict get $opts "-message"] ne "" } {
            puts -nonewline " ([dict get $opts "-message"])"
        }
        puts ""
        if { [dict get $opts "-frames"] < 0 } {
            set numFramesToPrint $numFrames
        } else {
            set numFramesToPrint [poMisc Min [expr {[dict get $opts "-frames"] + 2}] $numFrames]
        }
        for { set frameNum 2 } { $frameNum < $numFramesToPrint } { incr frameNum } {
            set caller [info frame -$frameNum]
            set fileName "Unknown"
            set lineNum  "-1"
            if { [dict exists $caller file] } {
                set fileName [file tail [dict get $caller file]]
            }
            if { [dict exists $caller line] } {
                set lineNum [dict get $caller line]
            }
            set cmd [dict get $caller cmd]
            set len [string length $cmd]
            if { [dict get $opts "-maxchars"] < 0 } {
                set endRange end
            } elseif { [dict get $opts "-maxchars"] == 0 } {
                set newlinePos [string first "\n" $cmd]
                if { $newlinePos > 0 } {
                    set endRange [expr { $newlinePos - 1 }]
                } else {
                    set endRange end
                }
            } else {
                set endRange [poMisc Min [dict get $opts "-maxchars"] $len]
            }
            lappend stack [list $fileName $lineNum [string range $cmd 0 $endRange]]
        }
        set maxLen 0
        foreach frame $stack {
            lassign $frame fileName lineNum code
            set fileNameLen [string length $fileName]
            set lineNumLen  [string length $lineNum]
            set totalLen [expr { $fileNameLen + $lineNumLen + 1 }]
            set maxLen [poMisc Max $maxLen $totalLen]
        }
        foreach frame $stack {
            lassign $frame fileName lineNum code
            set fileLineStr "$fileName:$lineNum"
            puts [format "%-*s %s" $maxLen $fileLineStr $code]
        }
        puts ""
    }

    proc SetShowConsole { { onOff 1 } } {
        variable levelOff
        variable consoleMode

        if { $onOff } {
            catch { poConsole Create .poSoftConsole {po> } {poSoft Console} }
            set consoleMode 1
        } else {
            catch { destroy .poSoftConsole }
            set consoleMode 0
        }
    }

    proc GetShowConsole {} {
        variable consoleMode

        return $consoleMode
    }

    proc GetDebugLevels {} {
        variable debugLevels

        return [list $debugLevels]
    }

    proc SetDebugLevels { levelList } {
        variable debugLevels
        variable levelOff

        set debugLevels {}
        foreach lev $levelList {
            if { $lev > $levelOff } {
                lappend debugLevels $lev
            } else {
                set debugLevels $levelOff
                return
            }
        }
    }

    proc GetDebugFile {} {
        variable debugFile

        return [list $debugFile]
    }

    proc SetDebugFile { fileName } {
        variable debugFile

        set debugFile $fileName
    }

    proc IsLoggingEnabled {} {
        variable consoleMode
        variable debugFile

        if { $consoleMode || $debugFile ne "" } {
            return true
        } else {
            return false
        }
    }

    proc LevelOff {} {
        variable levelOff
        return $levelOff
    }

    proc LevelInfo {} {
        variable levelInfo
        return $levelInfo
    }

    proc LevelWarning {} {
        variable levelWarning
        return $levelWarning
    }

    proc LevelError {} {
        variable levelError
        return $levelError
    }

    proc LevelDebug {} {
        variable levelDebug
        return $levelDebug
    }

    # Utility function for the following message setting functions.
    proc _PrintLogging { str level } {
        variable debugLevels
        variable debugFp
        variable debugFile
        variable debugFileOpen
        variable levelOff
        variable consoleMode

        if { $debugFile ne "" && ! $debugFileOpen } {
            set retVal [catch {open $debugFile w} fp]
            if { $retVal == 0 } {
                set debugFp $fp
                set debugFileOpen true
            }
        }

        if { ! [IsLoggingEnabled] } {
            return
        }

        if { [lsearch -exact $debugLevels $level] >= 0 } {
            catch { puts $debugFp "[info level -1]" }
            catch { flush $debugFp }
        }
    }

    proc Info { str } {
        variable levelInfo
        _PrintLogging $str $levelInfo
    }

    proc Warning { str } {
        variable levelWarning
        _PrintLogging $str $levelWarning
    }

    proc Error { str } {
        variable levelError
        _PrintLogging $str $levelError
    }

    proc Debug { str } {
        variable levelDebug
        _PrintLogging $str $levelDebug
    }

    # Utility function for Test.
    proc _P { str verbose } {
        if { $verbose } {
            puts $str
        }
    }

    proc Test { { verbose true } } {
        variable levelOff
        variable levelInfo
        variable levelWarning
        variable levelError
        variable levelDebug

        set retVal 1

        _P "" $verbose
        _P "Start of debug test" $verbose

        SetShowConsole 1
        for { set l $levelOff } { $l <= $levelDebug } { incr l } {
            _P "Setting debug level to: $l" $verbose
            SetDebugLevels $l

            Info      "This debug message should be printed at level Info"
            Warning   "This debug message should be printed at level Warning"
            Error     "This debug message should be printed at level Error"
            Debug     "This debug message should be printed at level Debug"

            _P "" $verbose
        }

        _P "Test finished" $verbose
        return $retVal
    }
}

poLog Init
