#
# log.test -- 
# nca-073-9
# 
# Copyright (c) 1996-2000 by Netcetera AG.
# Copyright (c) 2001 by Apache Software Foundation.
# All rights reserved.
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id$
#

# -----------------------------------------------------------------------------
# tcltest package
# -----------------------------------------------------------------------------

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

web::tempfile -remove

# -----------------------------------------------------------------------------
# util
# -----------------------------------------------------------------------------
proc logTestCatchMsg {msg} {
    return $msg
}

# -----------------------------------------------------------------------------
# manage filters
# -----------------------------------------------------------------------------
test log-1.1 {web::loglevel wrong number of arguments} {
    catch {web::loglevel} msg
    set msg
} {wrong # args: should be "web::loglevel option ?arg?"}

test log-1.2 {web::loglevel wrong argument} {
    catch {web::loglevel gugus} msg
    set msg
} {bad option "gugus": must be add, delete, names, or levels}

test log-1.2a {web::loglevel add wrong argument} {
    catch {web::loglevel add} msg
    set msg
} {wrong # args: should be "web::loglevel add level"}

test log-1.2b {web::loglevel delete wrong arguments} {
    catch {web::loglevel delete foo bar} msg
    set msg
} {wrong # args: should be "web::loglevel delete ?filtername?"}

test log-1.3 {websh3_weblog: add a filter} {
    web::loglevel delete
    web::loglevel add testWithoutAdd.alert-warning
    web::loglevel add testWithAdd.error-warning
    set res [web::loglevel levels]
    append res \n [web::loglevel names]
} {loglevel0 testWithoutAdd.alert-warning
loglevel1 testWithAdd.error-warning
loglevel0 loglevel1}

test log-1.4 {websh3_weblog: reset list of filters} {
    web::loglevel delete
    set res [web::loglevel names]
} {}

test log-1.5 {websh3_weblog: different warn levels and more than initial size list} {
    web::loglevel delete
    web::loglevel add testAlert.alert
    web::loglevel add testError.error
    web::loglevel add testWarning.warning
    web::loglevel add testInfo.info
    web::loglevel add testDebug.debug
    web::loglevel add testAlert.alert
    web::loglevel add testError.error
    web::loglevel add testWarning.warning
    web::loglevel add testInfo.info
    web::loglevel add testDebug.debug
    web::loglevel add testAlert.alert
    web::loglevel add testError.error
    web::loglevel add testWarning.warning
    web::loglevel add testInfo.info
    web::loglevel add testDebug.debug
    web::loglevel add testAlert.alert
    web::loglevel add testError.error
    web::loglevel add testWarning.warning
    web::loglevel add testInfo.info
    web::loglevel add testDebug.debug
    web::loglevel add testDebug.debug
    web::loglevel add testDebug.debug
    set res [web::loglevel levels]
} {loglevel0 testAlert.alert-alert
loglevel1 testError.error-error
loglevel2 testWarning.warning-warning
loglevel3 testInfo.info-info
loglevel4 testDebug.debug-debug
loglevel5 testAlert.alert-alert
loglevel6 testError.error-error
loglevel7 testWarning.warning-warning
loglevel8 testInfo.info-info
loglevel9 testDebug.debug-debug
loglevel10 testAlert.alert-alert
loglevel11 testError.error-error
loglevel12 testWarning.warning-warning
loglevel13 testInfo.info-info
loglevel14 testDebug.debug-debug
loglevel15 testAlert.alert-alert
loglevel16 testError.error-error
loglevel17 testWarning.warning-warning
loglevel18 testInfo.info-info
loglevel19 testDebug.debug-debug
loglevel20 testDebug.debug-debug
loglevel21 testDebug.debug-debug}

test log-1.6 {websh3_weblog: special syntax for message levels} {
    web::loglevel delete
    web::loglevel add *.-debug
    web::loglevel add *.alert-
    web::loglevel add *.alert-debug
    web::loglevel add test*.info
    web::loglevel add websh2.alert-error
    set res [web::loglevel levels]
} {loglevel0 *.alert-debug
loglevel1 *.alert-debug
loglevel2 *.alert-debug
loglevel3 test*.info-info
loglevel4 websh2.alert-error}

test log-1.7 {websh3_weblog: see if we get the id} {
    web::loglevel delete
    set id [web::loglevel add testWithoutAdd.alert-warning]
} {loglevel0}

test log-1.8 {websh3_weblog: test delete} {
    web::loglevel delete
    ## set-up a list of filters
    web::loglevel add test0.alert-warning
    set id [web::loglevel add test1.alert-warning]
    web::loglevel add test2.alert-warning
    ## now delete the middle one
    web::loglevel delete $id
    ## and see what we have
    web::loglevel levels
} {loglevel0 test0.alert-warning
loglevel2 test2.alert-warning}

test log-1.9 {websh3_weblog: tons of filters} {
    if {[info exists test]} {unset test}
    web::loglevel delete
    for {set i 0} {$i < 100} {incr i} {
	web::loglevel add test.alert
    }
    web::loglevel add last.warning
    set res [web::loglevel levels]
    set res [split $res "\n "]
    array set test $res
    set res $test(loglevel100)
} "last.warning-warning"

test log-1.10 {websh3_weblog: delete first filter} {
    web::loglevel delete
    ## set-up a list of filters
    set id [web::loglevel add test1.alert-warning]
    web::loglevel add test2.alert-warning
    web::loglevel add test3.alert-warning
    ## now delete the middle one
    web::loglevel delete $id
    ## and see what we have
    web::loglevel levels
} {loglevel1 test2.alert-warning
loglevel2 test3.alert-warning}

test log-1.11 {websh3_weblog: try to delete non-existing loglevel} {

    web::loglevel delete

    catch {
	web::loglevel delete "filter10"
    } msg
    set msg
} {no such log filter "filter10"}

test log-1.12 {web::loglevel bad format} {
    catch {web::loglevel add test.} msg
    set msg
} {wrong log level "test."}


# -----------------------------------------------------------------------------
# manage logdests (or "rules" or "destinations")
# -----------------------------------------------------------------------------
test log-2.1 {web::logdest wrong number of arguments} {
    catch {web::logdest} msg
    set msg
} {wrong # args: should be "web::logdest option arg ?arg ...?"}

test log-2.2 {web::logdest wrong argument} {
    catch {web::logdest gugus} msg
    set msg
} {bad option "gugus": must be add, delete, names, or levels}

test log-2.2a {web::logdest wrong add argument} {
    catch {web::logdest add} msg
    set msg
} {wrong # args: should be "web::logdest add ?options? level type ?type-specific-arguments ...?"}

test log-2.2b {web::logdest delete wrong arguments} {
    catch {web::logdest delete foo bar} msg
    set msg
} {wrong # args: should be "web::logdest delete ?destname?"}


test log-2.3 {websh3_weblog: logdest add returns id} {
    set fn [web::tempfile]
    web::logdest delete
    set res [web::logdest add info2.-debug file -unbuffered $fn]
    ## note: can only delete after logdest has closed file !
    web::logdest delete $res
    file delete $fn
    set res
} {logdest0}

test log-2.4 {websh3_weblog: break logbad add} {
    web::logdest delete
    catch {
	set res [web::logdest add info2.-debug -unbuffered file test.dat]
    } msg
    file delete test.dat
    set msg
} {no log handler of type "-unbuffered" registered}

test log-2.5 {websh3_weblog: add a logdest} {

    set curTim [clock seconds]

    web::loglevel delete
    web::logdest delete

    web::loglevel add *.-debug
    web::logdest add -format "$curTim \$m" *.-debug command logTestCatchMsg

    set tmp [web::log info {AABBCCDD}]

    set res [string compare $tmp "$curTim AABBCCDD"]
} {0}

test log-2.6 {websh3_weblog: test delete from logdest} {

    web::logdest delete
    set fh [open test.dat w]

    web::logdest add test0.alert file "test.dat"
    web::logdest add test1.error command dummy
    web::logdest add test2.warning channel $fh
    set id [web::logdest add test3.info command dummy]
    web::logdest add test4.debug command dummy

    ## now delete one
    web::logdest delete $id

    ## and see what we have
    set res [web::logdest levels]
    close $fh
    web::logdest delete
    file delete test.dat
    set res
} {logdest0 test0.alert-alert
logdest1 test1.error-error
logdest2 test2.warning-warning
logdest4 test4.debug-debug}

test log-2.7 {websh3_weblog: try to delete non-existing logdest} {

    web::logdest delete

    catch {
	web::logdest delete "logdest10"
    } msg
    set msg
} {no such log destination "logdest10"}


test log-3.0 {maxchar option} {

    web::logdest delete
    web::loglevel delete
    web::loglevel add *.-debug
    web::logdest add -maxchar 5 -format "\$m"  *.-debug command logTestCatchMsg
    set tmp [web::log info {ThisIsALongLogMsg}]
    set res [string compare $tmp "ThisI"]
} {0}

test log-3.1 {maxchar option, msg shorter than maxchar} {

    web::logdest delete
    web::loglevel delete
    web::loglevel add *.-debug
    web::logdest add -maxchar 5 -format "\$m"  *.-debug command logTestCatchMsg
    set tmp [web::log info {T}]
    set res [string compare $tmp "T"]
} {0}

test log-3.2 {truncate really long msg} {

    web::logdest delete
    web::loglevel delete
    web::loglevel add *.-debug
    web::logdest add -maxchar 5 -format "\$m"  *.-debug command logTestCatchMsg
    set tmp [web::log info [string repeat "Test" 10000]]
    set res [string compare $tmp "TestT"]
} {0}

test log-3.3 {-nosubst} {

    web::logdest delete
    web::loglevel delete
    web::loglevel add *.-debug
    web::logdest add -maxchar 5 -format "\$m"  *.-debug command logTestCatchMsg
    set i 0
    web::config logsubst 1
    set tmp [web::log info {[incr i]}]
    web::config logsubst 0
    set tmp [web::log info {[incr i]}]
    web::config logsubst 0
    set i
} {1}

test log-3.4 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::loglevel add foo} msg
    set msg
} {wrong log level "foo"}

test log-3.5 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::loglevel add foo.bar} msg
    set msg
} {wrong log level "foo.bar"}

test log-3.6 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::loglevel add foo.foo-bar} msg
    set msg
} {wrong log level "foo.foo-bar"}

test log-3.7 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::loglevel add foo.foo-bar-pi} msg
    set msg
} {wrong log level "foo.foo-bar-pi"}

test log-3.8 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::logdest add foo channel stdout} msg
    set msg
} {wrong log level "foo"}

test log-3.9 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::logdest add foo.bar channel stdout} msg
    set msg
} {wrong log level "foo.bar"}

test log-3.10 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::logdest add foo.foo-bar channel stdout} msg
    set msg
} {wrong log level "foo.foo-bar"}

test log-3.11 {invalid filter name} {

    web::logdest delete
    web::loglevel delete
    catch {web::logdest add foo.foo-bar-pi channel stdout} msg
    set msg
} {wrong log level "foo.foo-bar-pi"}

test log-3.12 {multiple channels (crash test)} {

    web::logdest delete
    web::loglevel delete
    web::logdest add *.-debug channel stdout
    web::logdest add *.-debug channel stdout
    web::logdest add *.-debug channel stdout
    web::logdest add *.-debug channel stdout
    set res [web::logdest levels]
    web::loglevel add *.-debug
    web::log debug test
    append res \n [web::logdest levels]

} {logdest0 *.alert-debug
logdest1 *.alert-debug
logdest2 *.alert-debug
logdest3 *.alert-debug
logdest0 *.alert-debug
logdest1 *.alert-debug
logdest2 *.alert-debug
logdest3 *.alert-debug}

test log-4.1 {fill up log filters} {
    set res {}
    web::loglevel delete
    web::loglevel add *.-debug
    web::loglevel add *.-debug
    web::loglevel add *.-debug
    lappend res [web::loglevel names]
    web::loglevel delete loglevel1
    lappend res [web::loglevel names]
    web::loglevel add *.-error
    lappend res [web::loglevel names]
    lappend res [web::loglevel levels]
} {{loglevel0 loglevel1 loglevel2} {loglevel0 loglevel2} {loglevel0 loglevel1 loglevel2} {loglevel0 *.alert-debug
loglevel1 *.alert-error
loglevel2 *.alert-debug}}

test log-5.1 {web::initializer logs} {

    web::loglevel delete
    web::logdest delete
    set res {}
    
    web::loglevel add *.-debug
    web::logdest add -maxchar 50 -format "\$m"  *.-debug command logTestCatchMsg
    lappend res [web::loglevel names] [web::logdest names]

    # since tests are in CGI mode, this is executed immediately
    web::initializer {
	web::loglevel add *.-debug
	web::logdest add -maxchar 50 -format "\$m"  *.-debug command logTestCatchMsg
    }
    lappend res [web::loglevel names] [web::logdest names]

    # this is supposed to delete all log filters and destinations not
    # created in web::initializer
    web::loglevel delete -requests
    web::logdest delete -requests
    lappend res [web::loglevel names] [web::logdest names]

    web::loglevel delete
    web::logdest delete
    lappend res [web::loglevel names] [web::logdest names]

} {loglevel0 logdest0 {loglevel0 loglevel1} {logdest0 logdest1} loglevel1 logdest1 {} {}}

# cleanup
::tcltest::cleanupTests